home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 7 / Apprentice-Release7.iso / Source Code / C / Applications / MacPerl 5.1.3 / Mac_Perl_513_src / perl5.002 / sv.c < prev    next >
Encoding:
C/C++ Source or Header  |  1997-01-15  |  72.4 KB  |  3,715 lines  |  [TEXT/MPS ]
  1. /*    sv.c
  2.  *
  3.  *    Copyright (c) 1991-1994, Larry Wall
  4.  *
  5.  *    You may distribute under the terms of either the GNU General Public
  6.  *    License or the Artistic License, as specified in the README file.
  7.  *
  8.  */
  9.  
  10. /*
  11.  * "I wonder what the Entish is for 'yes' and 'no'," he thought.
  12.  */
  13.  
  14. #include "EXTERN.h"
  15. #include "perl.h"
  16.  
  17. #ifdef OVR_DBL_DIG
  18. /* Use an overridden DBL_DIG */
  19. # ifdef DBL_DIG
  20. #  undef DBL_DIG
  21. # endif
  22. # define DBL_DIG OVR_DBL_DIG
  23. #else
  24. /* The following is all to get DBL_DIG, in order to pick a nice
  25.    default value for printing floating point numbers in Gconvert.
  26.    (see config.h)
  27. */
  28. #ifdef I_LIMITS
  29. #include <limits.h>
  30. #endif
  31. #ifdef I_FLOAT
  32. #include <float.h>
  33. #endif
  34. #ifndef HAS_DBL_DIG
  35. #define DBL_DIG    15   /* A guess that works lots of places */
  36. #endif
  37. #endif
  38.  
  39. #if defined(USE_STDIO_PTR) && defined(STDIO_PTR_LVALUE) && defined(STDIO_CNT_LVALUE)
  40. #  define FAST_SV_GETS
  41. #elif defined(macintosh)
  42. #  define FAST_SV_GETS
  43. #endif
  44.  
  45. static SV *more_sv _((void));
  46. static XPVIV *more_xiv _((void));
  47. static XPVNV *more_xnv _((void));
  48. static XPV *more_xpv _((void));
  49. static XRV *more_xrv _((void));
  50. static SV *new_sv _((void));
  51. static XPVIV *new_xiv _((void));
  52. static XPVNV *new_xnv _((void));
  53. static XPV *new_xpv _((void));
  54. static XRV *new_xrv _((void));
  55. static void del_xiv _((XPVIV* p));
  56. static void del_xnv _((XPVNV* p));
  57. static void del_xpv _((XPV* p));
  58. static void del_xrv _((XRV* p));
  59. static void sv_mortalgrow _((void));
  60.  
  61. static void sv_unglob _((SV* sv));
  62.  
  63. #ifdef PURIFY
  64.  
  65. #define new_SV() sv = (SV*)safemalloc(sizeof(SV))
  66. #define del_SV(p) free((char*)p)
  67.  
  68. void
  69. sv_add_arena(ptr, size, flags)
  70. char* ptr;
  71. U32 size;
  72. U32 flags;
  73. {
  74.     if (!(flags & SVf_FAKE))
  75.     free(ptr);
  76. }
  77.  
  78. #else
  79.  
  80. #define new_SV()            \
  81.     if (sv_root) {            \
  82.     sv = sv_root;            \
  83.     sv_root = (SV*)SvANY(sv);    \
  84.     ++sv_count;            \
  85.     }                    \
  86.     else                \
  87.     sv = more_sv();
  88.  
  89. static SV*
  90. new_sv()
  91. {
  92.     SV* sv;
  93.     if (sv_root) {
  94.     sv = sv_root;
  95.     sv_root = (SV*)SvANY(sv);
  96.     ++sv_count;
  97.     return sv;
  98.     }
  99.     return more_sv();
  100. }
  101.  
  102. #ifdef DEBUGGING
  103. #define del_SV(p)            \
  104.     if (debug & 32768)            \
  105.     del_sv(p);            \
  106.     else {                \
  107.     SvANY(p) = (void *)sv_root;    \
  108.     sv_root = p;            \
  109.     --sv_count;            \
  110.     }
  111.  
  112. static void
  113. del_sv(p)
  114. SV* p;
  115. {
  116.     if (debug & 32768) {
  117.     SV* sva;
  118.     SV* sv;
  119.     SV* svend;
  120.     int ok = 0;
  121.     for (sva = sv_arenaroot; sva; sva = (SV *) SvANY(sva)) {
  122.         sv = sva + 1;
  123.         svend = &sva[SvREFCNT(sva)];
  124.         if (p >= sv && p < svend)
  125.         ok = 1;
  126.     }
  127.     if (!ok) {
  128.         warn("Attempt to free non-arena SV: 0x%lx", (unsigned long)p);
  129.         return;
  130.     }
  131.     }
  132.     SvANY(p) = (void *) sv_root;
  133.     sv_root = p;
  134.     --sv_count;
  135. }
  136. #else
  137. #define del_SV(p)            \
  138.     SvANY(p) = (void *)sv_root;        \
  139.     sv_root = p;            \
  140.     --sv_count;
  141.  
  142. #endif
  143.  
  144. void
  145. sv_add_arena(ptr, size, flags)
  146. char* ptr;
  147. U32 size;
  148. U32 flags;
  149. {
  150.     SV* sva = (SV*)ptr;
  151.     register SV* sv;
  152.     register SV* svend;
  153.     Zero(sva, size, char);
  154.  
  155.     /* The first SV in an arena isn't an SV. */
  156.     SvANY(sva) = (void *) sv_arenaroot;        /* ptr to next arena */
  157.     SvREFCNT(sva) = size / sizeof(SV);        /* number of SV slots */
  158.     SvFLAGS(sva) = flags;            /* FAKE if not to be freed */
  159.  
  160.     sv_arenaroot = sva;
  161.     sv_root = sva + 1;
  162.  
  163.     svend = &sva[SvREFCNT(sva) - 1];
  164.     sv = sva + 1;
  165.     while (sv < svend) {
  166.     SvANY(sv) = (void *)(SV*)(sv + 1);
  167.     SvFLAGS(sv) = SVTYPEMASK;
  168.     sv++;
  169.     }
  170.     SvANY(sv) = 0;
  171.     SvFLAGS(sv) = SVTYPEMASK;
  172. }
  173.  
  174. static SV*
  175. more_sv()
  176. {
  177.     if (nice_chunk) {
  178.     sv_add_arena(nice_chunk, nice_chunk_size, 0);
  179.     nice_chunk = Nullch;
  180.     }
  181.     else
  182.     sv_add_arena(safemalloc(1008), 1008, 0);
  183.     return new_sv();
  184. }
  185. #endif
  186.  
  187. void
  188. sv_report_used()
  189. {
  190.     SV* sva;
  191.     SV* sv;
  192.     register SV* svend;
  193.  
  194.     for (sva = sv_arenaroot; sva; sva = (SV *) SvANY(sva)) {
  195.     sv = sva + 1;
  196.     svend = &sva[SvREFCNT(sva)];
  197.     while (sv < svend) {
  198.         if (SvTYPE(sv) != SVTYPEMASK) {
  199.         fprintf(stderr, "****\n");
  200.         sv_dump(sv);
  201.         }
  202.         ++sv;
  203.     }
  204.     }
  205. }
  206.  
  207. void
  208. sv_clean_objs()
  209. {
  210.     SV* sva;
  211.     register SV* sv;
  212.     register SV* svend;
  213.     SV* rv;
  214.  
  215. #ifndef DISABLE_DESTRUCTOR_KLUDGE
  216.     register GV* gv;
  217.     for (sva = sv_arenaroot; sva; sva = (SV *) SvANY(sva)) {
  218.     gv = sva + 1;
  219.     svend = &sva[SvREFCNT(sva)];
  220.     while (gv < svend) {
  221. #ifdef macintosh
  222.         if (SvTYPE(gv) == SVt_PVGV && GvGP(gv) && (sv = GvSV(gv)) &&
  223. #else
  224.         if (SvTYPE(gv) == SVt_PVGV && (sv = GvSV(gv)) &&
  225. #endif
  226.         SvROK(sv) && SvOBJECT(rv = SvRV(sv)))
  227.         {
  228.         DEBUG_D((fprintf(stderr, "Cleaning object ref:\n "),
  229.              sv_dump(sv));)
  230.         SvROK_off(sv);
  231.         SvRV(sv) = 0;
  232.         SvREFCNT_dec(rv);
  233.         }
  234.         ++gv;
  235.     }
  236.     }
  237.     if (!sv_objcount)
  238.     return;
  239. #endif
  240.     for (sva = sv_arenaroot; sva; sva = (SV *) SvANY(sva)) {
  241.     sv = sva + 1;
  242.     svend = &sva[SvREFCNT(sva)];
  243.     while (sv < svend) {
  244.         if (SvROK(sv) && SvOBJECT(rv = SvRV(sv))) {
  245.         DEBUG_D((fprintf(stderr, "Cleaning object ref:\n "),
  246.              sv_dump(sv));)
  247.         SvROK_off(sv);
  248.         SvRV(sv) = 0;
  249.         SvREFCNT_dec(rv);
  250.         }
  251.         /* XXX Might want to check arrays, etc. */
  252.         ++sv;
  253.     }
  254.     }
  255. }
  256.  
  257. static int in_clean_all = 0;
  258.  
  259. void
  260. sv_clean_all()
  261. {
  262.     SV* sva;
  263.     register SV* sv;
  264.     register SV* svend;
  265.  
  266.     in_clean_all = 1;
  267.     for (sva = sv_arenaroot; sva; sva = (SV*) SvANY(sva)) {
  268.     sv = sva + 1;
  269.     svend = &sva[SvREFCNT(sva)];
  270.     while (sv < svend) {
  271.         if (SvTYPE(sv) != SVTYPEMASK) {
  272.         DEBUG_D((fprintf(Perl_debug_log, "Cleaning loops:\n "), sv_dump(sv));)
  273.         SvFLAGS(sv) |= SVf_BREAK;
  274.         SvREFCNT_dec(sv);
  275.         }
  276.         ++sv;
  277.     }
  278.     }
  279.     in_clean_all = 0;
  280. }
  281.  
  282. #if 0
  283. static void
  284. sv_check_arenas(void * p)
  285. {
  286.     SV* sva;
  287.     SV* svanext;
  288.  
  289.     for (sva = sv_arenaroot; sva; sva = svanext) {
  290.         if ((char *)p >= (char *)sva && (char *)p < ((char *)sva)+1008)
  291.         Debugger();
  292.     svanext = (SV*) SvANY(sva);
  293.     }
  294. }
  295. #endif
  296.  
  297. void
  298. sv_free_arenas()
  299. {
  300.     SV* sva;
  301.     SV* svanext;
  302.  
  303.     /* Free arenas here, but be careful about fake ones.  (We assume
  304.        contiguity of the fake ones with the corresponding real ones.) */
  305.  
  306.     for (sva = sv_arenaroot; sva; sva = svanext) {
  307.     svanext = (SV*) SvANY(sva);
  308.     while (svanext && SvFAKE(svanext))
  309.         svanext = (SV*) SvANY(svanext);
  310.  
  311.     if (!SvFAKE(sva))
  312.         safefree((void *)sva);
  313.     }
  314. }
  315.  
  316. static XPVIV*
  317. new_xiv()
  318. {
  319.     IV** xiv;
  320.     if (xiv_root) {
  321.     xiv = xiv_root;
  322.     /*
  323.      * See comment in more_xiv() -- RAM.
  324.      */
  325.     xiv_root = (IV**)*xiv;
  326.     return (XPVIV*)((char*)xiv - sizeof(XPV));
  327.     }
  328.     return more_xiv();
  329. }
  330.  
  331. static void
  332. del_xiv(p)
  333. XPVIV* p;
  334. {
  335.     IV** xiv = (IV**)((char*)(p) + sizeof(XPV));
  336.     *xiv = (IV *)xiv_root;
  337.     xiv_root = xiv;
  338. }
  339.  
  340. static XPVIV*
  341. more_xiv()
  342. {
  343.     register IV** xiv;
  344.     register IV** xivend;
  345.     XPV* ptr = (XPV*)safemalloc(1008);
  346.     ptr->xpv_pv = (char*)xiv_arenaroot;        /* linked list of xiv arenas */
  347.     xiv_arenaroot = ptr;            /* to keep Purify happy */
  348.  
  349.     xiv = (IV**) ptr;
  350.     xivend = &xiv[1008 / sizeof(IV *) - 1];
  351.     xiv += (sizeof(XPV) - 1) / sizeof(IV *) + 1;   /* fudge by size of XPV */
  352.     xiv_root = xiv;
  353.     while (xiv < xivend) {
  354.     *xiv = (IV *)(xiv + 1);
  355.     xiv++;
  356.     }
  357.     *xiv = 0;
  358.     return new_xiv();
  359. }
  360.  
  361. static XPVNV*
  362. new_xnv()
  363. {
  364.     double* xnv;
  365.     if (xnv_root) {
  366.     xnv = xnv_root;
  367.     xnv_root = *(double**)xnv;
  368.     return (XPVNV*)((char*)xnv - sizeof(XPVIV));
  369.     }
  370.     return more_xnv();
  371. }
  372.  
  373. static void
  374. del_xnv(p)
  375. XPVNV* p;
  376. {
  377.     double* xnv = (double*)((char*)(p) + sizeof(XPVIV));
  378.     *(double**)xnv = xnv_root;
  379.     xnv_root = xnv;
  380. }
  381.  
  382. static XPVNV*
  383. more_xnv()
  384. {
  385.     register double* xnv;
  386.     register double* xnvend;
  387.     xnv = (double*)safemalloc(1008);
  388.     xnvend = &xnv[1008 / sizeof(double) - 1];
  389.     xnv += (sizeof(XPVIV) - 1) / sizeof(double) + 1; /* fudge by sizeof XPVIV */
  390.     xnv_root = xnv;
  391.     while (xnv < xnvend) {
  392.     *(double**)xnv = (double*)(xnv + 1);
  393.     xnv++;
  394.     }
  395.     *(double**)xnv = 0;
  396.     return new_xnv();
  397. }
  398.  
  399. static XRV*
  400. new_xrv()
  401. {
  402.     XRV* xrv;
  403.     if (xrv_root) {
  404.     xrv = xrv_root;
  405.     xrv_root = (XRV*)xrv->xrv_rv;
  406.     return xrv;
  407.     }
  408.     return more_xrv();
  409. }
  410.  
  411. static void
  412. del_xrv(p)
  413. XRV* p;
  414. {
  415.     p->xrv_rv = (SV*)xrv_root;
  416.     xrv_root = p;
  417. }
  418.  
  419. static XRV*
  420. more_xrv()
  421. {
  422.     register XRV* xrv;
  423.     register XRV* xrvend;
  424.     xrv_root = (XRV*)safemalloc(1008);
  425.     xrv = xrv_root;
  426.     xrvend = &xrv[1008 / sizeof(XRV) - 1];
  427.     while (xrv < xrvend) {
  428.     xrv->xrv_rv = (SV*)(xrv + 1);
  429.     xrv++;
  430.     }
  431.     xrv->xrv_rv = 0;
  432.     return new_xrv();
  433. }
  434.  
  435. static XPV*
  436. new_xpv()
  437. {
  438.     XPV* xpv;
  439.     if (xpv_root) {
  440.     xpv = xpv_root;
  441.     xpv_root = (XPV*)xpv->xpv_pv;
  442.     return xpv;
  443.     }
  444.     return more_xpv();
  445. }
  446.  
  447. static void
  448. del_xpv(p)
  449. XPV* p;
  450. {
  451.     p->xpv_pv = (char*)xpv_root;
  452.     xpv_root = p;
  453. }
  454.  
  455. static XPV*
  456. more_xpv()
  457. {
  458.     register XPV* xpv;
  459.     register XPV* xpvend;
  460.     xpv_root = (XPV*)safemalloc(1008);
  461.     xpv = xpv_root;
  462.     xpvend = &xpv[1008 / sizeof(XPV) - 1];
  463.     while (xpv < xpvend) {
  464.     xpv->xpv_pv = (char*)(xpv + 1);
  465.     xpv++;
  466.     }
  467.     xpv->xpv_pv = 0;
  468.     return new_xpv();
  469. }
  470.  
  471. #ifdef PURIFY
  472. #define new_XIV() (void*)safemalloc(sizeof(XPVIV))
  473. #define del_XIV(p) free((char*)p)
  474. #else
  475. #define new_XIV() (void*)new_xiv()
  476. #define del_XIV(p) del_xiv(p)
  477. #endif
  478.  
  479. #ifdef PURIFY
  480. #define new_XNV() (void*)safemalloc(sizeof(XPVNV))
  481. #define del_XNV(p) free((char*)p)
  482. #else
  483. #define new_XNV() (void*)new_xnv()
  484. #define del_XNV(p) del_xnv(p)
  485. #endif
  486.  
  487. #ifdef PURIFY
  488. #define new_XRV() (void*)safemalloc(sizeof(XRV))
  489. #define del_XRV(p) free((char*)p)
  490. #else
  491. #define new_XRV() (void*)new_xrv()
  492. #define del_XRV(p) del_xrv(p)
  493. #endif
  494.  
  495. #ifdef PURIFY
  496. #define new_XPV() (void*)safemalloc(sizeof(XPV))
  497. #define del_XPV(p) free((char*)p)
  498. #else
  499. #define new_XPV() (void*)new_xpv()
  500. #define del_XPV(p) del_xpv(p)
  501. #endif
  502.  
  503. #define new_XPVIV() (void*)safemalloc(sizeof(XPVIV))
  504. #define del_XPVIV(p) free((char*)p)
  505.  
  506. #define new_XPVNV() (void*)safemalloc(sizeof(XPVNV))
  507. #define del_XPVNV(p) free((char*)p)
  508.  
  509. #define new_XPVMG() (void*)safemalloc(sizeof(XPVMG))
  510. #define del_XPVMG(p) free((char*)p)
  511.  
  512. #define new_XPVLV() (void*)safemalloc(sizeof(XPVLV))
  513. #define del_XPVLV(p) free((char*)p)
  514.  
  515. #define new_XPVAV() (void*)safemalloc(sizeof(XPVAV))
  516. #define del_XPVAV(p) free((char*)p)
  517.  
  518. #define new_XPVHV() (void*)safemalloc(sizeof(XPVHV))
  519. #define del_XPVHV(p) free((char*)p)
  520.  
  521. #define new_XPVCV() (void*)safemalloc(sizeof(XPVCV))
  522. #define del_XPVCV(p) free((char*)p)
  523.  
  524. #define new_XPVGV() (void*)safemalloc(sizeof(XPVGV))
  525. #define del_XPVGV(p) free((char*)p)
  526.  
  527. #define new_XPVBM() (void*)safemalloc(sizeof(XPVBM))
  528. #define del_XPVBM(p) free((char*)p)
  529.  
  530. #define new_XPVFM() (void*)safemalloc(sizeof(XPVFM))
  531. #define del_XPVFM(p) free((char*)p)
  532.  
  533. #define new_XPVIO() (void*)safemalloc(sizeof(XPVIO))
  534. #define del_XPVIO(p) free((char*)p)
  535.  
  536. bool
  537. sv_upgrade(sv, mt)
  538. register SV* sv;
  539. U32 mt;
  540. {
  541.     char*    pv;
  542.     U32        cur;
  543.     U32        len;
  544.     IV        iv;
  545.     double    nv;
  546.     MAGIC*    magic;
  547.     HV*        stash;
  548.  
  549.     if (SvTYPE(sv) == mt)
  550.     return TRUE;
  551.  
  552.     if (mt < SVt_PVIV)
  553.     (void)SvOOK_off(sv);
  554.  
  555.     switch (SvTYPE(sv)) {
  556.     case SVt_NULL:
  557.     pv    = 0;
  558.     cur    = 0;
  559.     len    = 0;
  560.     iv    = 0;
  561.     nv    = 0.0;
  562.     magic    = 0;
  563.     stash    = 0;
  564.     break;
  565.     case SVt_IV:
  566.     pv    = 0;
  567.     cur    = 0;
  568.     len    = 0;
  569.     iv    = SvIVX(sv);
  570.     nv    = (double)SvIVX(sv);
  571.     del_XIV(SvANY(sv));
  572.     magic    = 0;
  573.     stash    = 0;
  574.     if (mt == SVt_NV)
  575.         mt = SVt_PVNV;
  576.     else if (mt < SVt_PVIV)
  577.         mt = SVt_PVIV;
  578.     break;
  579.     case SVt_NV:
  580.     pv    = 0;
  581.     cur    = 0;
  582.     len    = 0;
  583.     nv    = SvNVX(sv);
  584.     iv    = I_32(nv);
  585.     magic    = 0;
  586.     stash    = 0;
  587.     del_XNV(SvANY(sv));
  588.     SvANY(sv) = 0;
  589.     if (mt < SVt_PVNV)
  590.         mt = SVt_PVNV;
  591.     break;
  592.     case SVt_RV:
  593.     pv    = (char*)SvRV(sv);
  594.     cur    = 0;
  595.     len    = 0;
  596.     iv    = (IV)pv;
  597.     nv    = (double)(unsigned long)pv;
  598.     del_XRV(SvANY(sv));
  599.     magic    = 0;
  600.     stash    = 0;
  601.     break;
  602.     case SVt_PV:
  603.     nv = 0.0;
  604.     pv    = SvPVX(sv);
  605.     cur    = SvCUR(sv);
  606.     len    = SvLEN(sv);
  607.     iv    = 0;
  608.     nv    = 0.0;
  609.     magic    = 0;
  610.     stash    = 0;
  611.     del_XPV(SvANY(sv));
  612.     if (mt <= SVt_IV)
  613.         mt = SVt_PVIV;
  614.     else if (mt == SVt_NV)
  615.         mt = SVt_PVNV;
  616.     break;
  617.     case SVt_PVIV:
  618.     nv = 0.0;
  619.     pv    = SvPVX(sv);
  620.     cur    = SvCUR(sv);
  621.     len    = SvLEN(sv);
  622.     iv    = SvIVX(sv);
  623.     nv    = 0.0;
  624.     magic    = 0;
  625.     stash    = 0;
  626.     del_XPVIV(SvANY(sv));
  627.     break;
  628.     case SVt_PVNV:
  629.     nv = SvNVX(sv);
  630.     pv    = SvPVX(sv);
  631.     cur    = SvCUR(sv);
  632.     len    = SvLEN(sv);
  633.     iv    = SvIVX(sv);
  634.     nv    = SvNVX(sv);
  635.     magic    = 0;
  636.     stash    = 0;
  637.     del_XPVNV(SvANY(sv));
  638.     break;
  639.     case SVt_PVMG:
  640.     pv    = SvPVX(sv);
  641.     cur    = SvCUR(sv);
  642.     len    = SvLEN(sv);
  643.     iv    = SvIVX(sv);
  644.     nv    = SvNVX(sv);
  645.     magic    = SvMAGIC(sv);
  646.     stash    = SvSTASH(sv);
  647.     del_XPVMG(SvANY(sv));
  648.     break;
  649.     default:
  650.     croak("Can't upgrade that kind of scalar");
  651.     }
  652.  
  653.     switch (mt) {
  654.     case SVt_NULL:
  655.     croak("Can't upgrade to undef");
  656.     case SVt_IV:
  657.     SvANY(sv) = new_XIV();
  658.     SvIVX(sv)    = iv;
  659.     break;
  660.     case SVt_NV:
  661.     SvANY(sv) = new_XNV();
  662.     SvNVX(sv)    = nv;
  663.     break;
  664.     case SVt_RV:
  665.     SvANY(sv) = new_XRV();
  666.     SvRV(sv) = (SV*)pv;
  667.     break;
  668.     case SVt_PV:
  669.     SvANY(sv) = new_XPV();
  670.     SvPVX(sv)    = pv;
  671.     SvCUR(sv)    = cur;
  672.     SvLEN(sv)    = len;
  673.     break;
  674.     case SVt_PVIV:
  675.     SvANY(sv) = new_XPVIV();
  676.     SvPVX(sv)    = pv;
  677.     SvCUR(sv)    = cur;
  678.     SvLEN(sv)    = len;
  679.     SvIVX(sv)    = iv;
  680.     if (SvNIOK(sv))
  681.         (void)SvIOK_on(sv);
  682.     SvNOK_off(sv);
  683.     break;
  684.     case SVt_PVNV:
  685.     SvANY(sv) = new_XPVNV();
  686.     SvPVX(sv)    = pv;
  687.     SvCUR(sv)    = cur;
  688.     SvLEN(sv)    = len;
  689.     SvIVX(sv)    = iv;
  690.     SvNVX(sv)    = nv;
  691.     break;
  692.     case SVt_PVMG:
  693.     SvANY(sv) = new_XPVMG();
  694.     SvPVX(sv)    = pv;
  695.     SvCUR(sv)    = cur;
  696.     SvLEN(sv)    = len;
  697.     SvIVX(sv)    = iv;
  698.     SvNVX(sv)    = nv;
  699.     SvMAGIC(sv)    = magic;
  700.     SvSTASH(sv)    = stash;
  701.     break;
  702.     case SVt_PVLV:
  703.     SvANY(sv) = new_XPVLV();
  704.     SvPVX(sv)    = pv;
  705.     SvCUR(sv)    = cur;
  706.     SvLEN(sv)    = len;
  707.     SvIVX(sv)    = iv;
  708.     SvNVX(sv)    = nv;
  709.     SvMAGIC(sv)    = magic;
  710.     SvSTASH(sv)    = stash;
  711.     LvTARGOFF(sv)    = 0;
  712.     LvTARGLEN(sv)    = 0;
  713.     LvTARG(sv)    = 0;
  714.     LvTYPE(sv)    = 0;
  715.     break;
  716.     case SVt_PVAV:
  717.     SvANY(sv) = new_XPVAV();
  718.     if (pv)
  719.         Safefree(pv);
  720.     SvPVX(sv)    = 0;
  721.     AvMAX(sv)    = 0;
  722.     AvFILL(sv)    = 0;
  723.     SvIVX(sv)    = 0;
  724.     SvNVX(sv)    = 0.0;
  725.     SvMAGIC(sv)    = magic;
  726.     SvSTASH(sv)    = stash;
  727.     AvALLOC(sv)    = 0;
  728.     AvARYLEN(sv)    = 0;
  729.     AvFLAGS(sv)    = 0;
  730.     break;
  731.     case SVt_PVHV:
  732.     SvANY(sv) = new_XPVHV();
  733.     if (pv)
  734.         Safefree(pv);
  735.     SvPVX(sv)    = 0;
  736.     HvFILL(sv)    = 0;
  737.     HvMAX(sv)    = 0;
  738.     HvKEYS(sv)    = 0;
  739.     SvNVX(sv)    = 0.0;
  740.     SvMAGIC(sv)    = magic;
  741.     SvSTASH(sv)    = stash;
  742.     HvRITER(sv)    = 0;
  743.     HvEITER(sv)    = 0;
  744.     HvPMROOT(sv)    = 0;
  745.     HvNAME(sv)    = 0;
  746.     break;
  747.     case SVt_PVCV:
  748.     SvANY(sv) = new_XPVCV();
  749.     Zero(SvANY(sv), 1, XPVCV);
  750.     SvPVX(sv)    = pv;
  751.     SvCUR(sv)    = cur;
  752.     SvLEN(sv)    = len;
  753.     SvIVX(sv)    = iv;
  754.     SvNVX(sv)    = nv;
  755.     SvMAGIC(sv)    = magic;
  756.     SvSTASH(sv)    = stash;
  757.     break;
  758.     case SVt_PVGV:
  759.     SvANY(sv) = new_XPVGV();
  760.     SvPVX(sv)    = pv;
  761.     SvCUR(sv)    = cur;
  762.     SvLEN(sv)    = len;
  763.     SvIVX(sv)    = iv;
  764.     SvNVX(sv)    = nv;
  765.     SvMAGIC(sv)    = magic;
  766.     SvSTASH(sv)    = stash;
  767.     GvGP(sv)    = 0;
  768.     GvNAME(sv)    = 0;
  769.     GvNAMELEN(sv)    = 0;
  770.     GvSTASH(sv)    = 0;
  771.     GvFLAGS(sv)    = 0;
  772.     break;
  773.     case SVt_PVBM:
  774.     SvANY(sv) = new_XPVBM();
  775.     SvPVX(sv)    = pv;
  776.     SvCUR(sv)    = cur;
  777.     SvLEN(sv)    = len;
  778.     SvIVX(sv)    = iv;
  779.     SvNVX(sv)    = nv;
  780.     SvMAGIC(sv)    = magic;
  781.     SvSTASH(sv)    = stash;
  782.     BmRARE(sv)    = 0;
  783.     BmUSEFUL(sv)    = 0;
  784.     BmPREVIOUS(sv)    = 0;
  785.     break;
  786.     case SVt_PVFM:
  787.     SvANY(sv) = new_XPVFM();
  788.     Zero(SvANY(sv), 1, XPVFM);
  789.     SvPVX(sv)    = pv;
  790.     SvCUR(sv)    = cur;
  791.     SvLEN(sv)    = len;
  792.     SvIVX(sv)    = iv;
  793.     SvNVX(sv)    = nv;
  794.     SvMAGIC(sv)    = magic;
  795.     SvSTASH(sv)    = stash;
  796.     break;
  797.     case SVt_PVIO:
  798.     SvANY(sv) = new_XPVIO();
  799.     Zero(SvANY(sv), 1, XPVIO);
  800.     SvPVX(sv)    = pv;
  801.     SvCUR(sv)    = cur;
  802.     SvLEN(sv)    = len;
  803.     SvIVX(sv)    = iv;
  804.     SvNVX(sv)    = nv;
  805.     SvMAGIC(sv)    = magic;
  806.     SvSTASH(sv)    = stash;
  807.     IoPAGE_LEN(sv)    = 60;
  808.     break;
  809.     }
  810.     SvFLAGS(sv) &= ~SVTYPEMASK;
  811.     SvFLAGS(sv) |= mt;
  812.     return TRUE;
  813. }
  814.  
  815. #ifdef DEBUGGING
  816. char *
  817. sv_peek(sv)
  818. register SV *sv;
  819. {
  820.     char *t = tokenbuf;
  821.     int unref = 0;
  822.  
  823.   retry:
  824.     if (!sv) {
  825.     strcpy(t, "VOID");
  826.     goto finish;
  827.     }
  828.     else if (sv == (SV*)0x55555555 || SvTYPE(sv) == 'U') {
  829.     strcpy(t, "WILD");
  830.     goto finish;
  831.     }
  832.     else if (sv == &sv_undef || sv == &sv_no || sv == &sv_yes) {
  833.     if (sv == &sv_undef) {
  834.         strcpy(t, "SV_UNDEF");
  835.         if (!(SvFLAGS(sv) & (SVf_OK|SVf_OOK|SVs_OBJECT|
  836.                  SVs_GMG|SVs_SMG|SVs_RMG)) &&
  837.         SvREADONLY(sv))
  838.         goto finish;
  839.     }
  840.     else if (sv == &sv_no) {
  841.         strcpy(t, "SV_NO");
  842.         if (!(SvFLAGS(sv) & (SVf_ROK|SVf_OOK|SVs_OBJECT|
  843.                  SVs_GMG|SVs_SMG|SVs_RMG)) &&
  844.         !(~SvFLAGS(sv) & (SVf_POK|SVf_NOK|SVf_READONLY|
  845.                   SVp_POK|SVp_NOK)) &&
  846.         SvCUR(sv) == 0 &&
  847.         SvNVX(sv) == 0.0)
  848.         goto finish;
  849.     }
  850.     else {
  851.         strcpy(t, "SV_YES");
  852.         if (!(SvFLAGS(sv) & (SVf_ROK|SVf_OOK|SVs_OBJECT|
  853.                  SVs_GMG|SVs_SMG|SVs_RMG)) &&
  854.         !(~SvFLAGS(sv) & (SVf_POK|SVf_NOK|SVf_READONLY|
  855.                   SVp_POK|SVp_NOK)) &&
  856.         SvCUR(sv) == 1 &&
  857.         SvPVX(sv) && *SvPVX(sv) == '1' &&
  858.         SvNVX(sv) == 1.0)
  859.         goto finish;
  860.     }
  861.     t += strlen(t);
  862.     *t++ = ':';
  863.     }
  864.     else if (SvREFCNT(sv) == 0) {
  865.     *t++ = '(';
  866.     unref++;
  867.     }
  868.     if (SvROK(sv)) {
  869.     *t++ = '\\';
  870.     if (t - tokenbuf + unref > 10) {
  871.         strcpy(tokenbuf + unref + 3,"...");
  872.         goto finish;
  873.     }
  874.     sv = (SV*)SvRV(sv);
  875.     goto retry;
  876.     }
  877.     switch (SvTYPE(sv)) {
  878.     default:
  879.     strcpy(t,"FREED");
  880.     goto finish;
  881.  
  882.     case SVt_NULL:
  883.     strcpy(t,"UNDEF");
  884.     return tokenbuf;
  885.     case SVt_IV:
  886.     strcpy(t,"IV");
  887.     break;
  888.     case SVt_NV:
  889.     strcpy(t,"NV");
  890.     break;
  891.     case SVt_RV:
  892.     strcpy(t,"RV");
  893.     break;
  894.     case SVt_PV:
  895.     strcpy(t,"PV");
  896.     break;
  897.     case SVt_PVIV:
  898.     strcpy(t,"PVIV");
  899.     break;
  900.     case SVt_PVNV:
  901.     strcpy(t,"PVNV");
  902.     break;
  903.     case SVt_PVMG:
  904.     strcpy(t,"PVMG");
  905.     break;
  906.     case SVt_PVLV:
  907.     strcpy(t,"PVLV");
  908.     break;
  909.     case SVt_PVAV:
  910.     strcpy(t,"AV");
  911.     break;
  912.     case SVt_PVHV:
  913.     strcpy(t,"HV");
  914.     break;
  915.     case SVt_PVCV:
  916.     if (CvGV(sv))
  917.         sprintf(t, "CV(%s)", GvNAME(CvGV(sv)));
  918.     else
  919.         strcpy(t, "CV()");
  920.     goto finish;
  921.     case SVt_PVGV:
  922.     strcpy(t,"GV");
  923.     break;
  924.     case SVt_PVBM:
  925.     strcpy(t,"BM");
  926.     break;
  927.     case SVt_PVFM:
  928.     strcpy(t,"FM");
  929.     break;
  930.     case SVt_PVIO:
  931.     strcpy(t,"IO");
  932.     break;
  933.     }
  934.     t += strlen(t);
  935.  
  936.     if (SvPOKp(sv)) {
  937.     if (!SvPVX(sv))
  938.         strcpy(t, "(null)");
  939.     if (SvOOK(sv))
  940.         sprintf(t,"(%ld+\"%.127s\")",(long)SvIVX(sv),SvPVX(sv));
  941.     else
  942.         sprintf(t,"(\"%.127s\")",SvPVX(sv));
  943.     }
  944.     else if (SvNOKp(sv))
  945.     sprintf(t,"(%g)",SvNVX(sv));
  946.     else if (SvIOKp(sv))
  947.     sprintf(t,"(%ld)",(long)SvIVX(sv));
  948.     else
  949.     strcpy(t,"()");
  950.     
  951.   finish:
  952.     if (unref) {
  953.     t += strlen(t);
  954.     while (unref--)
  955.         *t++ = ')';
  956.     *t = '\0';
  957.     }
  958.     return tokenbuf;
  959. }
  960. #endif
  961.  
  962. int
  963. sv_backoff(sv)
  964. register SV *sv;
  965. {
  966.     assert(SvOOK(sv));
  967.     if (SvIVX(sv)) {
  968.     char *s = SvPVX(sv);
  969.     SvLEN(sv) += SvIVX(sv);
  970.     SvPVX(sv) -= SvIVX(sv);
  971.     SvIV_set(sv, 0);
  972.     Move(s, SvPVX(sv), SvCUR(sv)+1, char);
  973.     }
  974.     SvFLAGS(sv) &= ~SVf_OOK;
  975.     return 0;
  976. }
  977.  
  978. char *
  979. sv_grow(sv,newlen)
  980. register SV *sv;
  981. #ifndef DOSISH
  982. register I32 newlen;
  983. #else
  984. unsigned long newlen;
  985. #endif
  986. {
  987.     register char *s;
  988.  
  989. #ifdef MSDOS
  990.     if (newlen >= 0x10000) {
  991.     fprintf(stderr, "Allocation too large: %lx\n", newlen);
  992.     my_exit(1);
  993.     }
  994. #endif /* MSDOS */
  995.     if (SvROK(sv))
  996.     sv_unref(sv);
  997.     if (SvTYPE(sv) < SVt_PV) {
  998.     sv_upgrade(sv, SVt_PV);
  999.     s = SvPVX(sv);
  1000.     }
  1001.     else if (SvOOK(sv)) {    /* pv is offset? */
  1002.     sv_backoff(sv);
  1003.     s = SvPVX(sv);
  1004.     if (newlen > SvLEN(sv))
  1005.         newlen += 10 * (newlen - SvCUR(sv)); /* avoid copy each time */
  1006.     }
  1007.     else
  1008.     s = SvPVX(sv);
  1009.     if (newlen > SvLEN(sv)) {        /* need more room? */
  1010.         if (SvLEN(sv) && s)
  1011.         Renew(s,newlen,char);
  1012.         else
  1013.         New(703,s,newlen,char);
  1014.     SvPV_set(sv, s);
  1015.         SvLEN_set(sv, newlen);
  1016.     }
  1017.     return s;
  1018. }
  1019.  
  1020. void
  1021. sv_setiv(sv,i)
  1022. register SV *sv;
  1023. IV i;
  1024. {
  1025.     if (SvTHINKFIRST(sv)) {
  1026.     if (SvREADONLY(sv) && curcop != &compiling)
  1027.         croak(no_modify);
  1028.     if (SvROK(sv))
  1029.         sv_unref(sv);
  1030.     }
  1031.     switch (SvTYPE(sv)) {
  1032.     case SVt_NULL:
  1033.     sv_upgrade(sv, SVt_IV);
  1034.     break;
  1035.     case SVt_NV:
  1036.     sv_upgrade(sv, SVt_PVNV);
  1037.     break;
  1038.     case SVt_RV:
  1039.     case SVt_PV:
  1040.     sv_upgrade(sv, SVt_PVIV);
  1041.     break;
  1042.  
  1043.     case SVt_PVGV:
  1044.     if (SvFAKE(sv)) {
  1045.         sv_unglob(sv);
  1046.         break;
  1047.     }
  1048.     /* FALL THROUGH */
  1049.     case SVt_PVAV:
  1050.     case SVt_PVHV:
  1051.     case SVt_PVCV:
  1052.     case SVt_PVFM:
  1053.     case SVt_PVIO:
  1054.     croak("Can't coerce %s to integer in %s", sv_reftype(sv,0),
  1055.         op_name[op->op_type]);
  1056.     }
  1057.     (void)SvIOK_only(sv);            /* validate number */
  1058.     SvIVX(sv) = i;
  1059.     SvTAINT(sv);
  1060. }
  1061.  
  1062. void
  1063. sv_setnv(sv,num)
  1064. register SV *sv;
  1065. double num;
  1066. {
  1067.     if (SvTHINKFIRST(sv)) {
  1068.     if (SvREADONLY(sv) && curcop != &compiling)
  1069.         croak(no_modify);
  1070.     if (SvROK(sv))
  1071.         sv_unref(sv);
  1072.     }
  1073.     switch (SvTYPE(sv)) {
  1074.     case SVt_NULL:
  1075.     case SVt_IV:
  1076.     sv_upgrade(sv, SVt_NV);
  1077.     break;
  1078.     case SVt_NV:
  1079.     case SVt_RV:
  1080.     case SVt_PV:
  1081.     case SVt_PVIV:
  1082.     sv_upgrade(sv, SVt_PVNV);
  1083.     /* FALL THROUGH */
  1084.     case SVt_PVNV:
  1085.     case SVt_PVMG:
  1086.     case SVt_PVBM:
  1087.     case SVt_PVLV:
  1088.     if (SvOOK(sv))
  1089.         (void)SvOOK_off(sv);
  1090.     break;
  1091.     case SVt_PVGV:
  1092.     if (SvFAKE(sv)) {
  1093.         sv_unglob(sv);
  1094.         break;
  1095.     }
  1096.     /* FALL THROUGH */
  1097.     case SVt_PVAV:
  1098.     case SVt_PVHV:
  1099.     case SVt_PVCV:
  1100.     case SVt_PVFM:
  1101.     case SVt_PVIO:
  1102.     croak("Can't coerce %s to number in %s", sv_reftype(sv,0),
  1103.         op_name[op->op_type]);
  1104.     }
  1105.     SvNVX(sv) = num;
  1106.     (void)SvNOK_only(sv);            /* validate number */
  1107.     SvTAINT(sv);
  1108. }
  1109.  
  1110. static void
  1111. not_a_number(sv)
  1112. SV *sv;
  1113. {
  1114.     char tmpbuf[64];
  1115.     char *d = tmpbuf;
  1116.     char *s;
  1117.     int i;
  1118.  
  1119.     for (s = SvPVX(sv), i = 50; *s && i; s++,i--) {
  1120.     int ch = *s;
  1121.     if (ch & 128 && !isprint(ch)) {
  1122.         *d++ = 'M';
  1123.         *d++ = '-';
  1124.         ch &= 127;
  1125.     }
  1126.     if (isprint(ch))
  1127.         *d++ = ch;
  1128.     else {
  1129.         *d++ = '^';
  1130.         *d++ = ch ^ 64;
  1131.     }
  1132.     }
  1133.     if (*s) {
  1134.     *d++ = '.';
  1135.     *d++ = '.';
  1136.     *d++ = '.';
  1137.     }
  1138.     *d = '\0';
  1139.  
  1140.     if (op)
  1141.     warn("Argument \"%s\" isn't numeric in %s", tmpbuf,
  1142.         op_name[op->op_type]);
  1143.     else
  1144.     warn("Argument \"%s\" isn't numeric", tmpbuf);
  1145. }
  1146.  
  1147. IV
  1148. sv_2iv(sv)
  1149. register SV *sv;
  1150. {
  1151.     if (!sv)
  1152.     return 0;
  1153.     if (SvGMAGICAL(sv)) {
  1154.     mg_get(sv);
  1155.     if (SvIOKp(sv))
  1156.         return SvIVX(sv);
  1157.     if (SvNOKp(sv)) {
  1158.         if (SvNVX(sv) < 0.0)
  1159.         return I_V(SvNVX(sv));
  1160.         else
  1161.         return (IV) U_V(SvNVX(sv));
  1162.     }
  1163.     if (SvPOKp(sv) && SvLEN(sv)) {
  1164.         if (dowarn && !looks_like_number(sv))
  1165.         not_a_number(sv);
  1166.         return (IV)atol(SvPVX(sv));
  1167.     }
  1168.         if (!SvROK(sv)) {
  1169.             return 0;
  1170.         }
  1171.     }
  1172.     if (SvTHINKFIRST(sv)) {
  1173.     if (SvROK(sv)) {
  1174. #ifdef OVERLOAD
  1175.       SV* tmpstr;
  1176.       if (SvAMAGIC(sv) && (tmpstr=AMG_CALLun(sv, numer)))
  1177.         return SvIV(tmpstr);
  1178. #endif /* OVERLOAD */
  1179.       return (IV)SvRV(sv);
  1180.     }
  1181.     if (SvREADONLY(sv)) {
  1182.         if (SvNOKp(sv)) {
  1183.         if (SvNVX(sv) < 0.0)
  1184.             return I_V(SvNVX(sv));
  1185.         else
  1186.             return (IV) U_V(SvNVX(sv));
  1187.         }
  1188.         if (SvPOKp(sv) && SvLEN(sv)) {
  1189.         if (dowarn && !looks_like_number(sv))
  1190.             not_a_number(sv);
  1191.         return (IV)atol(SvPVX(sv));
  1192.         }
  1193.         if (dowarn)
  1194.         warn(warn_uninit);
  1195.         return 0;
  1196.     }
  1197.     }
  1198.     switch (SvTYPE(sv)) {
  1199.     case SVt_NULL:
  1200.     sv_upgrade(sv, SVt_IV);
  1201.     return SvIVX(sv);
  1202.     case SVt_PV:
  1203.     sv_upgrade(sv, SVt_PVIV);
  1204.     break;
  1205.     case SVt_NV:
  1206.     sv_upgrade(sv, SVt_PVNV);
  1207.     break;
  1208.     }
  1209.     if (SvNOKp(sv)) {
  1210.     (void)SvIOK_on(sv);
  1211.     if (SvNVX(sv) < 0.0)
  1212.         SvIVX(sv) = I_V(SvNVX(sv));
  1213.     else
  1214.         SvIVX(sv) = (IV) U_V(SvNVX(sv));
  1215.     }
  1216.     else if (SvPOKp(sv) && SvLEN(sv)) {
  1217.     if (dowarn && !looks_like_number(sv))
  1218.         not_a_number(sv);
  1219.     (void)SvIOK_on(sv);
  1220.     SvIVX(sv) = (IV)atol(SvPVX(sv));
  1221.     }
  1222.     else  {
  1223.     if (dowarn && !localizing && !(SvFLAGS(sv) & SVs_PADTMP))
  1224.         warn(warn_uninit);
  1225.     return 0;
  1226.     }
  1227.     (void)SvIOK_on(sv);
  1228.     DEBUG_c(fprintf(Perl_debug_log,"0x%lx 2iv(%ld)\n",
  1229.     (unsigned long)sv,(long)SvIVX(sv)));
  1230.     return SvIVX(sv);
  1231. }
  1232.  
  1233. double
  1234. sv_2nv(sv)
  1235. register SV *sv;
  1236. {
  1237.     if (!sv)
  1238.     return 0.0;
  1239.     if (SvGMAGICAL(sv)) {
  1240.     mg_get(sv);
  1241.     if (SvNOKp(sv))
  1242.         return SvNVX(sv);
  1243.     if (SvPOKp(sv) && SvLEN(sv)) {
  1244.         if (dowarn && !SvIOKp(sv) && !looks_like_number(sv))
  1245.         not_a_number(sv);
  1246.         return atof(SvPVX(sv));
  1247.     }
  1248.     if (SvIOKp(sv))
  1249.         return (double)SvIVX(sv);
  1250.         if (!SvROK(sv)) {
  1251.             return 0;
  1252.         }
  1253.     }
  1254.     if (SvTHINKFIRST(sv)) {
  1255.     if (SvROK(sv)) {
  1256. #ifdef OVERLOAD
  1257.       SV* tmpstr;
  1258.       if (SvAMAGIC(sv) && (tmpstr=AMG_CALLun(sv,numer)))
  1259.         return SvNV(tmpstr);
  1260. #endif /* OVERLOAD */
  1261.       return (double)(unsigned long)SvRV(sv);
  1262.     }
  1263.     if (SvREADONLY(sv)) {
  1264.         if (SvPOKp(sv) && SvLEN(sv)) {
  1265.         if (dowarn && !SvIOKp(sv) && !looks_like_number(sv))
  1266.             not_a_number(sv);
  1267.         return atof(SvPVX(sv));
  1268.         }
  1269.         if (SvIOKp(sv))
  1270.         return (double)SvIVX(sv);
  1271.         if (dowarn)
  1272.         warn(warn_uninit);
  1273.         return 0.0;
  1274.     }
  1275.     }
  1276.     if (SvTYPE(sv) < SVt_NV) {
  1277.     if (SvTYPE(sv) == SVt_IV)
  1278.         sv_upgrade(sv, SVt_PVNV);
  1279.     else
  1280.         sv_upgrade(sv, SVt_NV);
  1281.     DEBUG_c(fprintf(Perl_debug_log,"0x%lx num(%g)\n",(unsigned long)sv,SvNVX(sv)));
  1282.     }
  1283.     else if (SvTYPE(sv) < SVt_PVNV)
  1284.     sv_upgrade(sv, SVt_PVNV);
  1285.     if (SvIOKp(sv) &&
  1286.         (!SvPOKp(sv) || !strchr(SvPVX(sv),'.') || !looks_like_number(sv)))
  1287.     {
  1288.     SvNVX(sv) = (double)SvIVX(sv);
  1289.     }
  1290.     else if (SvPOKp(sv) && SvLEN(sv)) {
  1291.     if (dowarn && !SvIOKp(sv) && !looks_like_number(sv))
  1292.         not_a_number(sv);
  1293.     SvNVX(sv) = atof(SvPVX(sv));
  1294.     }
  1295.     else  {
  1296.     if (dowarn && !localizing && !(SvFLAGS(sv) & SVs_PADTMP))
  1297.         warn(warn_uninit);
  1298.     return 0.0;
  1299.     }
  1300.     SvNOK_on(sv);
  1301.     DEBUG_c(fprintf(Perl_debug_log,"0x%lx 2nv(%g)\n",(unsigned long)sv,SvNVX(sv)));
  1302.     return SvNVX(sv);
  1303. }
  1304.  
  1305. char *
  1306. sv_2pv(sv, lp)
  1307. register SV *sv;
  1308. STRLEN *lp;
  1309. {
  1310.     register char *s;
  1311.     int olderrno;
  1312.  
  1313.     if (!sv) {
  1314.     *lp = 0;
  1315.     return "";
  1316.     }
  1317.     if (SvGMAGICAL(sv)) {
  1318.     mg_get(sv);
  1319.     if (SvPOKp(sv)) {
  1320.         *lp = SvCUR(sv);
  1321.         return SvPVX(sv);
  1322.     }
  1323.     if (SvIOKp(sv)) {
  1324.         (void)sprintf(tokenbuf,"%ld",(long)SvIVX(sv));
  1325.         goto tokensave;
  1326.     }
  1327.     if (SvNOKp(sv)) {
  1328.         Gconvert(SvNVX(sv), DBL_DIG, 0, tokenbuf);
  1329.         goto tokensave;
  1330.     }
  1331.         if (!SvROK(sv)) {
  1332.             *lp = 0;
  1333.             return "";
  1334.         }
  1335.     }
  1336.     if (SvTHINKFIRST(sv)) {
  1337.     if (SvROK(sv)) {
  1338. #ifdef OVERLOAD
  1339.         SV* tmpstr;
  1340.         if (SvAMAGIC(sv) && (tmpstr=AMG_CALLun(sv,string)))
  1341.           return SvPV(tmpstr,*lp);
  1342. #endif /* OVERLOAD */
  1343.         sv = (SV*)SvRV(sv);
  1344.         if (!sv)
  1345.         s = "NULLREF";
  1346.         else {
  1347.         switch (SvTYPE(sv)) {
  1348.         case SVt_NULL:
  1349.         case SVt_IV:
  1350.         case SVt_NV:
  1351.         case SVt_RV:
  1352.         case SVt_PV:
  1353.         case SVt_PVIV:
  1354.         case SVt_PVNV:
  1355.         case SVt_PVBM:
  1356.         case SVt_PVMG:    s = "SCALAR";            break;
  1357.         case SVt_PVLV:    s = "LVALUE";            break;
  1358.         case SVt_PVAV:    s = "ARRAY";            break;
  1359.         case SVt_PVHV:    s = "HASH";            break;
  1360.         case SVt_PVCV:    s = "CODE";            break;
  1361.         case SVt_PVGV:    s = "GLOB";            break;
  1362.         case SVt_PVFM:    s = "FORMATLINE";        break;
  1363.         case SVt_PVIO:    s = "FILEHANDLE";        break;
  1364.         default:    s = "UNKNOWN";            break;
  1365.         }
  1366.         if (SvOBJECT(sv))
  1367.             sprintf(tokenbuf, "%s=%s(0x%lx)",
  1368.                 HvNAME(SvSTASH(sv)), s, (unsigned long)sv);
  1369.         else
  1370.             sprintf(tokenbuf, "%s(0x%lx)", s, (unsigned long)sv);
  1371.         goto tokensaveref;
  1372.         }
  1373.         *lp = strlen(s);
  1374.         return s;
  1375.     }
  1376.     if (SvREADONLY(sv)) {
  1377.         if (SvNOKp(sv)) {
  1378.         Gconvert(SvNVX(sv), DBL_DIG, 0, tokenbuf);
  1379.         goto tokensave;
  1380.         }
  1381.         if (SvIOKp(sv)) {
  1382.         (void)sprintf(tokenbuf,"%ld",(long)SvIVX(sv));
  1383.         goto tokensave;
  1384.         }
  1385.         if (dowarn)
  1386.         warn(warn_uninit);
  1387.         *lp = 0;
  1388.         return "";
  1389.     }
  1390.     }
  1391.     if (!SvUPGRADE(sv, SVt_PV))
  1392.     return 0;
  1393.     if (SvNOKp(sv)) {
  1394.     if (SvTYPE(sv) < SVt_PVNV)
  1395.         sv_upgrade(sv, SVt_PVNV);
  1396.     SvGROW(sv, 28);
  1397.     s = SvPVX(sv);
  1398.     olderrno = errno;    /* some Xenix systems wipe out errno here */
  1399. #ifdef apollo
  1400.     if (SvNVX(sv) == 0.0)
  1401.         (void)strcpy(s,"0");
  1402.     else
  1403. #endif /*apollo*/
  1404.         Gconvert(SvNVX(sv), DBL_DIG, 0, s);
  1405.     errno = olderrno;
  1406. #ifdef FIXNEGATIVEZERO
  1407.         if (*s == '-' && s[1] == '0' && !s[2])
  1408.         strcpy(s,"0");
  1409. #endif
  1410.     while (*s) s++;
  1411. #ifdef hcx
  1412.     if (s[-1] == '.')
  1413.         s--;
  1414. #endif
  1415.     }
  1416.     else if (SvIOKp(sv)) {
  1417.     if (SvTYPE(sv) < SVt_PVIV)
  1418.         sv_upgrade(sv, SVt_PVIV);
  1419.     SvGROW(sv, 11);
  1420.     s = SvPVX(sv);
  1421.     olderrno = errno;    /* some Xenix systems wipe out errno here */
  1422.     (void)sprintf(s,"%ld",(long)SvIVX(sv));
  1423.     errno = olderrno;
  1424.     while (*s) s++;
  1425.     }
  1426.     else {
  1427.     if (dowarn && !localizing && !(SvFLAGS(sv) & SVs_PADTMP))
  1428.         warn(warn_uninit);
  1429.     *lp = 0;
  1430.     return "";
  1431.     }
  1432.     *s = '\0';
  1433.     *lp = s - SvPVX(sv);
  1434.     SvCUR_set(sv, *lp);
  1435.     SvPOK_on(sv);
  1436.     DEBUG_c(fprintf(Perl_debug_log,"0x%lx 2pv(%s)\n",(unsigned long)sv,SvPVX(sv)));
  1437.     return SvPVX(sv);
  1438.  
  1439.   tokensave:
  1440.     if (SvROK(sv)) {    /* XXX Skip this when sv_pvn_force calls */
  1441.     /* Sneaky stuff here */
  1442.  
  1443.       tokensaveref:
  1444.     sv = sv_newmortal();
  1445.     *lp = strlen(tokenbuf);
  1446.     sv_setpvn(sv, tokenbuf, *lp);
  1447.     return SvPVX(sv);
  1448.     }
  1449.     else {
  1450.     STRLEN len;
  1451.     
  1452. #ifdef FIXNEGATIVEZERO
  1453.     if (*tokenbuf == '-' && tokenbuf[1] == '0' && !tokenbuf[2])
  1454.         strcpy(tokenbuf,"0");
  1455. #endif
  1456.     (void)SvUPGRADE(sv, SVt_PV);
  1457.     len = *lp = strlen(tokenbuf);
  1458.     s = SvGROW(sv, len + 1);
  1459.     SvCUR_set(sv, len);
  1460.     (void)strcpy(s, tokenbuf);
  1461.     /* NO SvPOK_on(sv) here! */
  1462.     return s;
  1463.     }
  1464. }
  1465.  
  1466. /* This function is only called on magical items */
  1467. bool
  1468. sv_2bool(sv)
  1469. register SV *sv;
  1470. {
  1471.     if (SvGMAGICAL(sv))
  1472.     mg_get(sv);
  1473.  
  1474.     if (!SvOK(sv))
  1475.     return 0;
  1476.     if (SvROK(sv)) {
  1477. #ifdef OVERLOAD
  1478.       {
  1479.     SV* tmpsv;
  1480.     if (SvAMAGIC(sv) && (tmpsv = AMG_CALLun(sv,bool_)))
  1481.       return SvTRUE(tmpsv);
  1482.       }
  1483. #endif /* OVERLOAD */
  1484.       return SvRV(sv) != 0;
  1485.     }
  1486.     if (SvPOKp(sv)) {
  1487.     register XPV* Xpv;
  1488.     if ((Xpv = (XPV*)SvANY(sv)) &&
  1489.         (*Xpv->xpv_pv > '0' ||
  1490.         Xpv->xpv_cur > 1 ||
  1491.         (Xpv->xpv_cur && *Xpv->xpv_pv != '0')))
  1492.         return 1;
  1493.     else
  1494.         return 0;
  1495.     }
  1496.     else {
  1497.     if (SvIOKp(sv))
  1498.         return SvIVX(sv) != 0;
  1499.     else {
  1500.         if (SvNOKp(sv))
  1501.         return SvNVX(sv) != 0.0;
  1502.         else
  1503.         return FALSE;
  1504.     }
  1505.     }
  1506. }
  1507.  
  1508. /* Note: sv_setsv() should not be called with a source string that needs
  1509.  * to be reused, since it may destroy the source string if it is marked
  1510.  * as temporary.
  1511.  */
  1512.  
  1513. void
  1514. sv_setsv(dstr,sstr)
  1515. SV *dstr;
  1516. register SV *sstr;
  1517. {
  1518.     register U32 sflags;
  1519.     register int dtype;
  1520.     register int stype;
  1521.  
  1522.     if (sstr == dstr)
  1523.     return;
  1524.     if (SvTHINKFIRST(dstr)) {
  1525.     if (SvREADONLY(dstr) && curcop != &compiling)
  1526.         croak(no_modify);
  1527.     if (SvROK(dstr))
  1528.         sv_unref(dstr);
  1529.     }
  1530.     if (!sstr)
  1531.     sstr = &sv_undef;
  1532.     stype = SvTYPE(sstr);
  1533.     dtype = SvTYPE(dstr);
  1534.  
  1535.     if (dtype == SVt_PVGV && (SvFLAGS(dstr) & SVf_FAKE)) {
  1536.         sv_unglob(dstr);     /* so fake GLOB won't perpetuate */
  1537.     sv_setpvn(dstr, "", 0);
  1538.         (void)SvPOK_only(dstr);
  1539.         dtype = SvTYPE(dstr);
  1540.     }
  1541.  
  1542. #ifdef OVERLOAD
  1543.     SvAMAGIC_off(dstr);
  1544. #endif /* OVERLOAD */
  1545.     /* There's a lot of redundancy below but we're going for speed here */
  1546.  
  1547.     switch (stype) {
  1548.     case SVt_NULL:
  1549.     (void)SvOK_off(dstr);
  1550.     return;
  1551.     case SVt_IV:
  1552.     if (dtype <= SVt_PV) {
  1553.         if (dtype < SVt_IV)
  1554.         sv_upgrade(dstr, SVt_IV);
  1555.         else if (dtype == SVt_NV)
  1556.         sv_upgrade(dstr, SVt_PVNV);
  1557.         else if (dtype <= SVt_PV)
  1558.         sv_upgrade(dstr, SVt_PVIV);
  1559.     }
  1560.     break;
  1561.     case SVt_NV:
  1562.     if (dtype <= SVt_PVIV) {
  1563.         if (dtype < SVt_NV)
  1564.         sv_upgrade(dstr, SVt_NV);
  1565.         else if (dtype == SVt_PVIV)
  1566.         sv_upgrade(dstr, SVt_PVNV);
  1567.         else if (dtype <= SVt_PV)
  1568.         sv_upgrade(dstr, SVt_PVNV);
  1569.     }
  1570.     break;
  1571.     case SVt_RV:
  1572.     if (dtype < SVt_RV)
  1573.         sv_upgrade(dstr, SVt_RV);
  1574.     else if (dtype == SVt_PVGV &&
  1575.          SvTYPE(SvRV(sstr)) == SVt_PVGV) {
  1576.         sstr = SvRV(sstr);
  1577.         if (sstr == dstr) {
  1578.         if (curcop->cop_stash != GvSTASH(dstr))
  1579.             GvIMPORTED_on(dstr);
  1580.         GvMULTI_on(dstr);
  1581.         return;
  1582.         }
  1583.         goto glob_assign;
  1584.     }
  1585.     break;
  1586.     case SVt_PV:
  1587.     if (dtype < SVt_PV)
  1588.         sv_upgrade(dstr, SVt_PV);
  1589.     break;
  1590.     case SVt_PVIV:
  1591.     if (dtype < SVt_PVIV)
  1592.         sv_upgrade(dstr, SVt_PVIV);
  1593.     break;
  1594.     case SVt_PVNV:
  1595.     if (dtype < SVt_PVNV)
  1596.         sv_upgrade(dstr, SVt_PVNV);
  1597.     break;
  1598.  
  1599.     case SVt_PVLV:
  1600.     sv_upgrade(dstr, SVt_PVNV);
  1601.     break;
  1602.  
  1603.     case SVt_PVAV:
  1604.     case SVt_PVHV:
  1605.     case SVt_PVCV:
  1606.     case SVt_PVIO:
  1607.     if (op)
  1608.         croak("Bizarre copy of %s in %s", sv_reftype(sstr, 0),
  1609.         op_name[op->op_type]);
  1610.     else
  1611.         croak("Bizarre copy of %s", sv_reftype(sstr, 0));
  1612.     break;
  1613.  
  1614.     case SVt_PVGV:
  1615.     if (dtype <= SVt_PVGV) {
  1616.   glob_assign:
  1617.         if (dtype != SVt_PVGV) {
  1618.         char *name = GvNAME(sstr);
  1619.         STRLEN len = GvNAMELEN(sstr);
  1620.         sv_upgrade(dstr, SVt_PVGV);
  1621.         sv_magic(dstr, dstr, '*', name, len);
  1622.         GvSTASH(dstr) = GvSTASH(sstr);
  1623.         GvNAME(dstr) = savepvn(name, len);
  1624.         GvNAMELEN(dstr) = len;
  1625.         SvFAKE_on(dstr);    /* can coerce to non-glob */
  1626.         }
  1627.         (void)SvOK_off(dstr);
  1628.         GvINTRO_off(dstr);        /* one-shot flag */
  1629.         gp_free(dstr);
  1630.         GvGP(dstr) = gp_ref(GvGP(sstr));
  1631.         SvTAINT(dstr);
  1632.         if (curcop->cop_stash != GvSTASH(dstr))
  1633.         GvIMPORTED_on(dstr);
  1634.         GvMULTI_on(dstr);
  1635.         return;
  1636.     }
  1637.     /* FALL THROUGH */
  1638.  
  1639.     default:
  1640.     if (dtype < stype)
  1641.         sv_upgrade(dstr, stype);
  1642.     if (SvGMAGICAL(sstr))
  1643.         mg_get(sstr);
  1644.     }
  1645.  
  1646.     sflags = SvFLAGS(sstr);
  1647.  
  1648.     if (sflags & SVf_ROK) {
  1649.     if (dtype >= SVt_PV) {
  1650.         if (dtype == SVt_PVGV) {
  1651.         SV *sref = SvREFCNT_inc(SvRV(sstr));
  1652.         SV *dref = 0;
  1653.         int intro = GvINTRO(dstr);
  1654.  
  1655.         if (intro) {
  1656.             GP *gp;
  1657.             GvGP(dstr)->gp_refcnt--;
  1658.             GvINTRO_off(dstr);    /* one-shot flag */
  1659.             Newz(602,gp, 1, GP);
  1660.             GvGP(dstr) = gp;
  1661.             GvREFCNT(dstr) = 1;
  1662.             GvSV(dstr) = NEWSV(72,0);
  1663.             GvLINE(dstr) = curcop->cop_line;
  1664.             GvEGV(dstr) = dstr;
  1665.         }
  1666.         GvMULTI_on(dstr);
  1667.         switch (SvTYPE(sref)) {
  1668.         case SVt_PVAV:
  1669.             if (intro)
  1670.             SAVESPTR(GvAV(dstr));
  1671.             else
  1672.             dref = (SV*)GvAV(dstr);
  1673.             GvAV(dstr) = (AV*)sref;
  1674.             if (curcop->cop_stash != GvSTASH(dstr))
  1675.             GvIMPORTED_AV_on(dstr);
  1676.             break;
  1677.         case SVt_PVHV:
  1678.             if (intro)
  1679.             SAVESPTR(GvHV(dstr));
  1680.             else
  1681.             dref = (SV*)GvHV(dstr);
  1682.             GvHV(dstr) = (HV*)sref;
  1683.             if (curcop->cop_stash != GvSTASH(dstr))
  1684.             GvIMPORTED_HV_on(dstr);
  1685.             break;
  1686.         case SVt_PVCV:
  1687.             if (intro)
  1688.             SAVESPTR(GvCV(dstr));
  1689.             else {
  1690.             CV* cv = GvCV(dstr);
  1691.             if (cv) {
  1692.                 dref = (SV*)cv;
  1693.                 if (dowarn && sref != dref &&
  1694.                     !GvCVGEN((GV*)dstr) &&
  1695.                     (CvROOT(cv) || CvXSUB(cv)) )
  1696.                 warn("Subroutine %s redefined",
  1697.                     GvENAME((GV*)dstr));
  1698.                 SvFAKE_on(cv);
  1699.             }
  1700.             }
  1701.             if (GvCV(dstr) != (CV*)sref) {
  1702.             GvCV(dstr) = (CV*)sref;
  1703.             GvASSUMECV_on(dstr);
  1704.             }
  1705.             if (curcop->cop_stash != GvSTASH(dstr))
  1706.             GvIMPORTED_CV_on(dstr);
  1707.             break;
  1708.         case SVt_PVIO:
  1709.             if (intro)
  1710.             SAVESPTR(GvIOp(dstr));
  1711.             else
  1712.             dref = (SV*)GvIOp(dstr);
  1713.             GvIOp(dstr) = (IO*)sref;
  1714.             break;
  1715.         default:
  1716.             if (intro)
  1717.             SAVESPTR(GvSV(dstr));
  1718.             else
  1719.             dref = (SV*)GvSV(dstr);
  1720.             GvSV(dstr) = sref;
  1721.             if (curcop->cop_stash != GvSTASH(dstr))
  1722.             GvIMPORTED_SV_on(dstr);
  1723.             break;
  1724.         }
  1725.         if (dref)
  1726.             SvREFCNT_dec(dref);
  1727.         if (intro)
  1728.             SAVEFREESV(sref);
  1729.         SvTAINT(dstr);
  1730.         return;
  1731.         }
  1732.         if (SvPVX(dstr)) {
  1733.         Safefree(SvPVX(dstr));
  1734.         SvLEN(dstr)=SvCUR(dstr)=0;
  1735.         }
  1736.     }
  1737.     (void)SvOK_off(dstr);
  1738.     SvRV(dstr) = SvREFCNT_inc(SvRV(sstr));
  1739.     SvROK_on(dstr);
  1740.     if (sflags & SVp_NOK) {
  1741.         SvNOK_on(dstr);
  1742.         SvNVX(dstr) = SvNVX(sstr);
  1743.     }
  1744.     if (sflags & SVp_IOK) {
  1745.         (void)SvIOK_on(dstr);
  1746.         SvIVX(dstr) = SvIVX(sstr);
  1747.     }
  1748. #ifdef OVERLOAD
  1749.     if (SvAMAGIC(sstr)) {
  1750.         SvAMAGIC_on(dstr);
  1751.     }
  1752. #endif /* OVERLOAD */
  1753.     }
  1754.     else if (sflags & SVp_POK) {
  1755.  
  1756.     /*
  1757.      * Check to see if we can just swipe the string.  If so, it's a
  1758.      * possible small lose on short strings, but a big win on long ones.
  1759.      * It might even be a win on short strings if SvPVX(dstr)
  1760.      * has to be allocated and SvPVX(sstr) has to be freed.
  1761.      */
  1762.  
  1763.     if (SvTEMP(sstr) &&        /* slated for free anyway? */
  1764.         !(sflags & SVf_OOK))     /* and not involved in OOK hack? */
  1765.     {
  1766.         if (SvPVX(dstr)) {        /* we know that dtype >= SVt_PV */
  1767.         if (SvOOK(dstr)) {
  1768.             SvFLAGS(dstr) &= ~SVf_OOK;
  1769.             Safefree(SvPVX(dstr) - SvIVX(dstr));
  1770.         }
  1771.         else
  1772.             Safefree(SvPVX(dstr));
  1773.         }
  1774.         (void)SvPOK_only(dstr);
  1775.         SvPV_set(dstr, SvPVX(sstr));
  1776.         SvLEN_set(dstr, SvLEN(sstr));
  1777.         SvCUR_set(dstr, SvCUR(sstr));
  1778.         SvTEMP_off(dstr);
  1779.         (void)SvOK_off(sstr);
  1780.         SvPV_set(sstr, Nullch);
  1781.         SvLEN_set(sstr, 0);
  1782.         SvCUR_set(sstr, 0);
  1783.         SvTEMP_off(sstr);
  1784.     }
  1785.     else {                    /* have to copy actual string */
  1786.         STRLEN len = SvCUR(sstr);
  1787.  
  1788.         SvGROW(dstr, len + 1);        /* inlined from sv_setpvn */
  1789.         Move(SvPVX(sstr),SvPVX(dstr),len,char);
  1790.         SvCUR_set(dstr, len);
  1791.         *SvEND(dstr) = '\0';
  1792.         (void)SvPOK_only(dstr);
  1793.     }
  1794.     /*SUPPRESS 560*/
  1795.     if (sflags & SVp_NOK) {
  1796.         SvNOK_on(dstr);
  1797.         SvNVX(dstr) = SvNVX(sstr);
  1798.     }
  1799.     if (sflags & SVp_IOK) {
  1800.         (void)SvIOK_on(dstr);
  1801.         SvIVX(dstr) = SvIVX(sstr);
  1802.     }
  1803.     }
  1804.     else if (sflags & SVp_NOK) {
  1805.     SvNVX(dstr) = SvNVX(sstr);
  1806.     (void)SvNOK_only(dstr);
  1807.     if (SvIOK(sstr)) {
  1808.         (void)SvIOK_on(dstr);
  1809.         SvIVX(dstr) = SvIVX(sstr);
  1810.     }
  1811.     }
  1812.     else if (sflags & SVp_IOK) {
  1813.     (void)SvIOK_only(dstr);
  1814.     SvIVX(dstr) = SvIVX(sstr);
  1815.     }
  1816.     else {
  1817.     (void)SvOK_off(dstr);
  1818.     }
  1819.     SvTAINT(dstr);
  1820. }
  1821.  
  1822. void
  1823. sv_setpvn(sv,ptr,len)
  1824. register SV *sv;
  1825. register char *ptr;
  1826. register STRLEN len;
  1827. {
  1828.     assert(len >= 0);
  1829.     if (SvTHINKFIRST(sv)) {
  1830.     if (SvREADONLY(sv) && curcop != &compiling)
  1831.         croak(no_modify);
  1832.     if (SvROK(sv))
  1833.         sv_unref(sv);
  1834.     }
  1835.     if (!ptr) {
  1836.     (void)SvOK_off(sv);
  1837.     return;
  1838.     }
  1839.     if (SvTYPE(sv) >= SVt_PV) {
  1840.     if (SvFAKE(sv) && SvTYPE(sv) == SVt_PVGV)
  1841.         sv_unglob(sv);
  1842.     }
  1843.     else if (!sv_upgrade(sv, SVt_PV))
  1844.     return;
  1845.     SvGROW(sv, len + 1);
  1846.     Move(ptr,SvPVX(sv),len,char);
  1847.     SvCUR_set(sv, len);
  1848.     *SvEND(sv) = '\0';
  1849.     (void)SvPOK_only(sv);        /* validate pointer */
  1850.     SvTAINT(sv);
  1851. }
  1852.  
  1853. void
  1854. sv_setpv(sv,ptr)
  1855. register SV *sv;
  1856. register char *ptr;
  1857. {
  1858.     register STRLEN len;
  1859.  
  1860.     if (SvTHINKFIRST(sv)) {
  1861.     if (SvREADONLY(sv) && curcop != &compiling)
  1862.         croak(no_modify);
  1863.     if (SvROK(sv))
  1864.         sv_unref(sv);
  1865.     }
  1866.     if (!ptr) {
  1867.     (void)SvOK_off(sv);
  1868.     return;
  1869.     }
  1870.     len = strlen(ptr);
  1871.     if (SvTYPE(sv) >= SVt_PV) {
  1872.     if (SvFAKE(sv) && SvTYPE(sv) == SVt_PVGV)
  1873.         sv_unglob(sv);
  1874.     }
  1875.     else if (!sv_upgrade(sv, SVt_PV))
  1876.     return;
  1877.     SvGROW(sv, len + 1);
  1878.     Move(ptr,SvPVX(sv),len+1,char);
  1879.     SvCUR_set(sv, len);
  1880.     (void)SvPOK_only(sv);        /* validate pointer */
  1881.     SvTAINT(sv);
  1882. }
  1883.  
  1884. void
  1885. sv_usepvn(sv,ptr,len)
  1886. register SV *sv;
  1887. register char *ptr;
  1888. register STRLEN len;
  1889. {
  1890.     if (SvTHINKFIRST(sv)) {
  1891.     if (SvREADONLY(sv) && curcop != &compiling)
  1892.         croak(no_modify);
  1893.     if (SvROK(sv))
  1894.         sv_unref(sv);
  1895.     }
  1896.     if (!SvUPGRADE(sv, SVt_PV))
  1897.     return;
  1898.     if (!ptr) {
  1899.     (void)SvOK_off(sv);
  1900.     return;
  1901.     }
  1902.     if (SvPVX(sv))
  1903.     Safefree(SvPVX(sv));
  1904.     Renew(ptr, len+1, char);
  1905.     SvPVX(sv) = ptr;
  1906.     SvCUR_set(sv, len);
  1907.     SvLEN_set(sv, len+1);
  1908.     *SvEND(sv) = '\0';
  1909.     (void)SvPOK_only(sv);        /* validate pointer */
  1910.     SvTAINT(sv);
  1911. }
  1912.  
  1913. void
  1914. sv_chop(sv,ptr)    /* like set but assuming ptr is in sv */
  1915. register SV *sv;
  1916. register char *ptr;
  1917. {
  1918.     register STRLEN delta;
  1919.  
  1920.     if (!ptr || !SvPOKp(sv))
  1921.     return;
  1922.     if (SvTHINKFIRST(sv)) {
  1923.     if (SvREADONLY(sv) && curcop != &compiling)
  1924.         croak(no_modify);
  1925.     if (SvROK(sv))
  1926.         sv_unref(sv);
  1927.     }
  1928.     if (SvTYPE(sv) < SVt_PVIV)
  1929.     sv_upgrade(sv,SVt_PVIV);
  1930.  
  1931.     if (!SvOOK(sv)) {
  1932.     SvIVX(sv) = 0;
  1933.     SvFLAGS(sv) |= SVf_OOK;
  1934.     }
  1935.     SvFLAGS(sv) &= ~(SVf_IOK|SVf_NOK|SVp_IOK|SVp_NOK);
  1936.     delta = ptr - SvPVX(sv);
  1937.     SvLEN(sv) -= delta;
  1938.     SvCUR(sv) -= delta;
  1939.     SvPVX(sv) += delta;
  1940.     SvIVX(sv) += delta;
  1941. }
  1942.  
  1943. void
  1944. sv_catpvn(sv,ptr,len)
  1945. register SV *sv;
  1946. register char *ptr;
  1947. register STRLEN len;
  1948. {
  1949.     STRLEN tlen;
  1950.     char *junk;
  1951.  
  1952.     junk = SvPV_force(sv, tlen);
  1953.     SvGROW(sv, tlen + len + 1);
  1954.     if (ptr == junk)
  1955.     ptr = SvPVX(sv);
  1956.     Move(ptr,SvPVX(sv)+tlen,len,char);
  1957.     SvCUR(sv) += len;
  1958.     *SvEND(sv) = '\0';
  1959.     (void)SvPOK_only(sv);        /* validate pointer */
  1960.     SvTAINT(sv);
  1961. }
  1962.  
  1963. void
  1964. sv_catsv(dstr,sstr)
  1965. SV *dstr;
  1966. register SV *sstr;
  1967. {
  1968.     char *s;
  1969.     STRLEN len;
  1970.     if (!sstr)
  1971.     return;
  1972.     if (s = SvPV(sstr, len))
  1973.     sv_catpvn(dstr,s,len);
  1974. }
  1975.  
  1976. void
  1977. sv_catpv(sv,ptr)
  1978. register SV *sv;
  1979. register char *ptr;
  1980. {
  1981.     register STRLEN len;
  1982.     STRLEN tlen;
  1983.     char *junk;
  1984.  
  1985.     if (!ptr)
  1986.     return;
  1987.     junk = SvPV_force(sv, tlen);
  1988.     len = strlen(ptr);
  1989.     SvGROW(sv, tlen + len + 1);
  1990.     if (ptr == junk)
  1991.     ptr = SvPVX(sv);
  1992.     Move(ptr,SvPVX(sv)+tlen,len+1,char);
  1993.     SvCUR(sv) += len;
  1994.     (void)SvPOK_only(sv);        /* validate pointer */
  1995.     SvTAINT(sv);
  1996. }
  1997.  
  1998. SV *
  1999. #ifdef LEAKTEST
  2000. newSV(x,len)
  2001. I32 x;
  2002. #else
  2003. newSV(len)
  2004. #endif
  2005. STRLEN len;
  2006. {
  2007.     register SV *sv;
  2008.     
  2009.     new_SV();
  2010.     SvANY(sv) = 0;
  2011.     SvREFCNT(sv) = 1;
  2012.     SvFLAGS(sv) = 0;
  2013.     if (len) {
  2014.     sv_upgrade(sv, SVt_PV);
  2015.     SvGROW(sv, len + 1);
  2016.     }
  2017.     return sv;
  2018. }
  2019.  
  2020. void
  2021. sv_magic(sv, obj, how, name, namlen)
  2022. register SV *sv;
  2023. SV *obj;
  2024. int how;
  2025. char *name;
  2026. I32 namlen;
  2027. {
  2028.     MAGIC* mg;
  2029.     
  2030.     if (SvREADONLY(sv) && curcop != &compiling && !strchr("gB", how))
  2031.     croak(no_modify);
  2032.     if (SvMAGICAL(sv) || (how == 't' && SvTYPE(sv) >= SVt_PVMG)) {
  2033.     if (SvMAGIC(sv) && (mg = mg_find(sv, how))) {
  2034.         if (how == 't')
  2035.         mg->mg_len |= 1;
  2036.         return;
  2037.     }
  2038.     }
  2039.     else {
  2040.     if (!SvUPGRADE(sv, SVt_PVMG))
  2041.         return;
  2042.     }
  2043.     Newz(702,mg, 1, MAGIC);
  2044.     mg->mg_moremagic = SvMAGIC(sv);
  2045.  
  2046.     SvMAGIC(sv) = mg;
  2047.     if (!obj || obj == sv || how == '#')
  2048.     mg->mg_obj = obj;
  2049.     else {
  2050.     mg->mg_obj = SvREFCNT_inc(obj);
  2051.     mg->mg_flags |= MGf_REFCOUNTED;
  2052.     }
  2053.     mg->mg_type = how;
  2054.     mg->mg_len = namlen;
  2055.     if (name && namlen >= 0)
  2056.     mg->mg_ptr = savepvn(name, namlen);
  2057.     switch (how) {
  2058.     case 0:
  2059.     mg->mg_virtual = &vtbl_sv;
  2060.     break;
  2061. #ifdef OVERLOAD
  2062.     case 'A':
  2063.         mg->mg_virtual = &vtbl_amagic;
  2064.         break;
  2065.     case 'a':
  2066.         mg->mg_virtual = &vtbl_amagicelem;
  2067.         break;
  2068.     case 'c':
  2069.         mg->mg_virtual = 0;
  2070.         break;
  2071. #endif /* OVERLOAD */
  2072.     case 'B':
  2073.     mg->mg_virtual = &vtbl_bm;
  2074.     break;
  2075.     case 'E':
  2076.     mg->mg_virtual = &vtbl_env;
  2077.     break;
  2078.     case 'e':
  2079.     mg->mg_virtual = &vtbl_envelem;
  2080.     break;
  2081.     case 'g':
  2082.     mg->mg_virtual = &vtbl_mglob;
  2083.     break;
  2084.     case 'I':
  2085.     mg->mg_virtual = &vtbl_isa;
  2086.     break;
  2087.     case 'i':
  2088.     mg->mg_virtual = &vtbl_isaelem;
  2089.     break;
  2090.     case 'L':
  2091.     SvRMAGICAL_on(sv);
  2092.     mg->mg_virtual = 0;
  2093.     break;
  2094.     case 'l':
  2095.     mg->mg_virtual = &vtbl_dbline;
  2096.     break;
  2097.     case 'P':
  2098.     mg->mg_virtual = &vtbl_pack;
  2099.     break;
  2100.     case 'p':
  2101.     case 'q':
  2102.     mg->mg_virtual = &vtbl_packelem;
  2103.     break;
  2104.     case 'S':
  2105.     mg->mg_virtual = &vtbl_sig;
  2106.     break;
  2107.     case 's':
  2108.     mg->mg_virtual = &vtbl_sigelem;
  2109.     break;
  2110.     case 't':
  2111.     mg->mg_virtual = &vtbl_taint;
  2112.     mg->mg_len = 1;
  2113.     break;
  2114.     case 'U':
  2115.     mg->mg_virtual = &vtbl_uvar;
  2116.     break;
  2117.     case 'v':
  2118.     mg->mg_virtual = &vtbl_vec;
  2119.     break;
  2120.     case 'x':
  2121.     mg->mg_virtual = &vtbl_substr;
  2122.     break;
  2123.     case '*':
  2124.     mg->mg_virtual = &vtbl_glob;
  2125.     break;
  2126.     case '#':
  2127.     mg->mg_virtual = &vtbl_arylen;
  2128.     break;
  2129.     case '.':
  2130.     mg->mg_virtual = &vtbl_pos;
  2131.     break;
  2132.     case '~':    /* Reserved for use by extensions not perl internals.    */
  2133.     /* Useful for attaching extension internal data to perl vars.    */
  2134.     /* Note that multiple extensions may clash if magical scalars    */
  2135.     /* etc holding private data from one are passed to another.    */
  2136.     SvRMAGICAL_on(sv);
  2137.     break;
  2138.     default:
  2139.     croak("Don't know how to handle magic of type '%c'", how);
  2140.     }
  2141.     mg_magical(sv);
  2142.     if (SvGMAGICAL(sv))
  2143.     SvFLAGS(sv) &= ~(SVf_IOK|SVf_NOK|SVf_POK);
  2144. }
  2145.  
  2146. int
  2147. sv_unmagic(sv, type)
  2148. SV* sv;
  2149. int type;
  2150. {
  2151.     MAGIC* mg;
  2152.     MAGIC** mgp;
  2153.     if (SvTYPE(sv) < SVt_PVMG || !SvMAGIC(sv))
  2154.     return 0;
  2155.     mgp = &SvMAGIC(sv);
  2156.     for (mg = *mgp; mg; mg = *mgp) {
  2157.     if (mg->mg_type == type) {
  2158.         MGVTBL* vtbl = mg->mg_virtual;
  2159.         *mgp = mg->mg_moremagic;
  2160.         if (vtbl && vtbl->svt_free)
  2161.         (*vtbl->svt_free)(sv, mg);
  2162.         if (mg->mg_ptr && mg->mg_type != 'g')
  2163.         Safefree(mg->mg_ptr);
  2164.         if (mg->mg_flags & MGf_REFCOUNTED)
  2165.         SvREFCNT_dec(mg->mg_obj);
  2166.         Safefree(mg);
  2167.     }
  2168.     else
  2169.         mgp = &mg->mg_moremagic;
  2170.     }
  2171.     if (!SvMAGIC(sv)) {
  2172.     SvMAGICAL_off(sv);
  2173.     SvFLAGS(sv) |= (SvFLAGS(sv) & (SVp_IOK|SVp_NOK|SVp_POK)) >> PRIVSHIFT;
  2174.     }
  2175.  
  2176.     return 0;
  2177. }
  2178.  
  2179. void
  2180. sv_insert(bigstr,offset,len,little,littlelen)
  2181. SV *bigstr;
  2182. STRLEN offset;
  2183. STRLEN len;
  2184. char *little;
  2185. STRLEN littlelen;
  2186. {
  2187.     register char *big;
  2188.     register char *mid;
  2189.     register char *midend;
  2190.     register char *bigend;
  2191.     register I32 i;
  2192.  
  2193.     if (!bigstr)
  2194.     croak("Can't modify non-existent substring");
  2195.     SvPV_force(bigstr, na);
  2196.  
  2197.     i = littlelen - len;
  2198.     if (i > 0) {            /* string might grow */
  2199.     big = SvGROW(bigstr, SvCUR(bigstr) + i + 1);
  2200.     mid = big + offset + len;
  2201.     midend = bigend = big + SvCUR(bigstr);
  2202.     bigend += i;
  2203.     *bigend = '\0';
  2204.     while (midend > mid)        /* shove everything down */
  2205.         *--bigend = *--midend;
  2206.     Move(little,big+offset,littlelen,char);
  2207.     SvCUR(bigstr) += i;
  2208.     SvSETMAGIC(bigstr);
  2209.     return;
  2210.     }
  2211.     else if (i == 0) {
  2212.     Move(little,SvPVX(bigstr)+offset,len,char);
  2213.     SvSETMAGIC(bigstr);
  2214.     return;
  2215.     }
  2216.  
  2217.     big = SvPVX(bigstr);
  2218.     mid = big + offset;
  2219.     midend = mid + len;
  2220.     bigend = big + SvCUR(bigstr);
  2221.  
  2222.     if (midend > bigend)
  2223.     croak("panic: sv_insert");
  2224.  
  2225.     if (mid - big > bigend - midend) {    /* faster to shorten from end */
  2226.     if (littlelen) {
  2227.         Move(little, mid, littlelen,char);
  2228.         mid += littlelen;
  2229.     }
  2230.     i = bigend - midend;
  2231.     if (i > 0) {
  2232.         Move(midend, mid, i,char);
  2233.         mid += i;
  2234.     }
  2235.     *mid = '\0';
  2236.     SvCUR_set(bigstr, mid - big);
  2237.     }
  2238.     /*SUPPRESS 560*/
  2239.     else if (i = mid - big) {    /* faster from front */
  2240.     midend -= littlelen;
  2241.     mid = midend;
  2242.     sv_chop(bigstr,midend-i);
  2243.     big += i;
  2244.     while (i--)
  2245.         *--midend = *--big;
  2246.     if (littlelen)
  2247.         Move(little, mid, littlelen,char);
  2248.     }
  2249.     else if (littlelen) {
  2250.     midend -= littlelen;
  2251.     sv_chop(bigstr,midend);
  2252.     Move(little,midend,littlelen,char);
  2253.     }
  2254.     else {
  2255.     sv_chop(bigstr,midend);
  2256.     }
  2257.     SvSETMAGIC(bigstr);
  2258. }
  2259.  
  2260. /* make sv point to what nstr did */
  2261.  
  2262. void
  2263. sv_replace(sv,nsv)
  2264. register SV *sv;
  2265. register SV *nsv;
  2266. {
  2267.     U32 refcnt = SvREFCNT(sv);
  2268.     if (SvTHINKFIRST(sv)) {
  2269.     if (SvREADONLY(sv) && curcop != &compiling)
  2270.         croak(no_modify);
  2271.     if (SvROK(sv))
  2272.         sv_unref(sv);
  2273.     }
  2274.     if (SvREFCNT(nsv) != 1)
  2275.     warn("Reference miscount in sv_replace()");
  2276.     if (SvMAGICAL(sv)) {
  2277.     if (SvMAGICAL(nsv))
  2278.         mg_free(nsv);
  2279.     else
  2280.         sv_upgrade(nsv, SVt_PVMG);
  2281.     SvMAGIC(nsv) = SvMAGIC(sv);
  2282.     SvFLAGS(nsv) |= SvMAGICAL(sv);
  2283.     SvMAGICAL_off(sv);
  2284.     SvMAGIC(sv) = 0;
  2285.     }
  2286.     SvREFCNT(sv) = 0;
  2287.     sv_clear(sv);
  2288.     StructCopy(nsv,sv,SV);
  2289.     SvREFCNT(sv) = refcnt;
  2290.     SvFLAGS(nsv) |= SVTYPEMASK;        /* Mark as freed */
  2291.     del_SV(nsv);
  2292. }
  2293.  
  2294. void
  2295. sv_clear(sv)
  2296. register SV *sv;
  2297. {
  2298.     assert(sv);
  2299.     assert(SvREFCNT(sv) == 0);
  2300.  
  2301.     if (SvOBJECT(sv)) {
  2302.     dSP;
  2303.     GV* destructor;
  2304.  
  2305.     if (defstash) {        /* Still have a symbol table? */
  2306.         destructor = gv_fetchmethod(SvSTASH(sv), "DESTROY");
  2307.  
  2308.         ENTER;
  2309.         SAVEFREESV(SvSTASH(sv));
  2310.         if (destructor && GvCV(destructor)) {
  2311.         SV ref;
  2312.  
  2313.         Zero(&ref, 1, SV);
  2314.         sv_upgrade(&ref, SVt_RV);
  2315.         SAVEI32(SvREFCNT(sv));
  2316.         SvRV(&ref) = SvREFCNT_inc(sv);
  2317.         SvROK_on(&ref);
  2318.  
  2319.         EXTEND(SP, 2);
  2320.         PUSHMARK(SP);
  2321.         PUSHs(&ref);
  2322.         PUTBACK;
  2323.         perl_call_sv((SV*)destructor, G_DISCARD|G_EVAL|G_KEEPERR);
  2324.         del_XRV(SvANY(&ref));
  2325.         }
  2326.         LEAVE;
  2327.     }
  2328.     else
  2329.         SvREFCNT_dec(SvSTASH(sv));
  2330.     if (SvOBJECT(sv)) {
  2331.         SvOBJECT_off(sv);    /* Curse the object. */
  2332.         if (SvTYPE(sv) != SVt_PVIO)
  2333.         --sv_objcount;    /* XXX Might want something more general */
  2334.     }
  2335.     }
  2336.     if (SvTYPE(sv) >= SVt_PVMG && SvMAGIC(sv))
  2337.     mg_free(sv);
  2338.     switch (SvTYPE(sv)) {
  2339.     case SVt_PVIO:
  2340.     io_close((IO*)sv);
  2341.     Safefree(IoTOP_NAME(sv));
  2342.     Safefree(IoFMT_NAME(sv));
  2343.     Safefree(IoBOTTOM_NAME(sv));
  2344.     /* FALL THROUGH */
  2345.     case SVt_PVBM:
  2346.     goto freescalar;
  2347.     case SVt_PVCV:
  2348.     case SVt_PVFM:
  2349.     cv_undef((CV*)sv);
  2350.     goto freescalar;
  2351.     case SVt_PVHV:
  2352.     hv_undef((HV*)sv);
  2353.     break;
  2354.     case SVt_PVAV:
  2355.     av_undef((AV*)sv);
  2356.     break;
  2357.     case SVt_PVGV:
  2358.     gp_free(sv);
  2359.     Safefree(GvNAME(sv));
  2360.     /* FALL THROUGH */
  2361.     case SVt_PVLV:
  2362.     case SVt_PVMG:
  2363.     case SVt_PVNV:
  2364.     case SVt_PVIV:
  2365.       freescalar:
  2366.     (void)SvOOK_off(sv);
  2367.     /* FALL THROUGH */
  2368.     case SVt_PV:
  2369.     case SVt_RV:
  2370.     if (SvROK(sv))
  2371.         SvREFCNT_dec(SvRV(sv));
  2372.     else if (SvPVX(sv))
  2373.         Safefree(SvPVX(sv));
  2374.     break;
  2375. /*
  2376.     case SVt_NV:
  2377.     case SVt_IV:
  2378.     case SVt_NULL:
  2379.     break;
  2380. */
  2381.     }
  2382.  
  2383.     switch (SvTYPE(sv)) {
  2384.     case SVt_NULL:
  2385.     break;
  2386.     case SVt_IV:
  2387.     del_XIV(SvANY(sv));
  2388.     break;
  2389.     case SVt_NV:
  2390.     del_XNV(SvANY(sv));
  2391.     break;
  2392.     case SVt_RV:
  2393.     del_XRV(SvANY(sv));
  2394.     break;
  2395.     case SVt_PV:
  2396.     del_XPV(SvANY(sv));
  2397.     break;
  2398.     case SVt_PVIV:
  2399.     del_XPVIV(SvANY(sv));
  2400.     break;
  2401.     case SVt_PVNV:
  2402.     del_XPVNV(SvANY(sv));
  2403.     break;
  2404.     case SVt_PVMG:
  2405.     del_XPVMG(SvANY(sv));
  2406.     break;
  2407.     case SVt_PVLV:
  2408.     del_XPVLV(SvANY(sv));
  2409.     break;
  2410.     case SVt_PVAV:
  2411.     del_XPVAV(SvANY(sv));
  2412.     break;
  2413.     case SVt_PVHV:
  2414.     del_XPVHV(SvANY(sv));
  2415.     break;
  2416.     case SVt_PVCV:
  2417.     del_XPVCV(SvANY(sv));
  2418.     break;
  2419.     case SVt_PVGV:
  2420.     del_XPVGV(SvANY(sv));
  2421.     break;
  2422.     case SVt_PVBM:
  2423.     del_XPVBM(SvANY(sv));
  2424.     break;
  2425.     case SVt_PVFM:
  2426.     del_XPVFM(SvANY(sv));
  2427.     break;
  2428.     case SVt_PVIO:
  2429.     del_XPVIO(SvANY(sv));
  2430.     break;
  2431.     }
  2432.     SvFLAGS(sv) &= SVf_BREAK;
  2433.     SvFLAGS(sv) |= SVTYPEMASK;
  2434. }
  2435.  
  2436. SV *
  2437. sv_newref(sv)
  2438. SV* sv;
  2439. {
  2440.     if (sv)
  2441.     SvREFCNT(sv)++;
  2442.     return sv;
  2443. }
  2444.  
  2445. void
  2446. sv_free(sv)
  2447. SV *sv;
  2448. {
  2449.     if (!sv)
  2450.     return;
  2451.     if (SvREADONLY(sv)) {
  2452.     if (sv == &sv_undef || sv == &sv_yes || sv == &sv_no)
  2453.         return;
  2454.     }
  2455.     if (SvREFCNT(sv) == 0) {
  2456.     if (SvFLAGS(sv) & SVf_BREAK)
  2457.         return;
  2458.     if (in_clean_all) /* All is fair */
  2459.         return;
  2460.     warn("Attempt to free unreferenced scalar");
  2461.     return;
  2462.     }
  2463.     if (--SvREFCNT(sv) > 0)
  2464.     return;
  2465. #ifdef DEBUGGING
  2466.     if (SvTEMP(sv)) {
  2467.     warn("Attempt to free temp prematurely");
  2468.     return;
  2469.     }
  2470. #endif
  2471.     sv_clear(sv);
  2472.     del_SV(sv);
  2473. }
  2474.  
  2475. STRLEN
  2476. sv_len(sv)
  2477. register SV *sv;
  2478. {
  2479.     char *junk;
  2480.     STRLEN len;
  2481.  
  2482.     if (!sv)
  2483.     return 0;
  2484.  
  2485.     if (SvGMAGICAL(sv))
  2486.     len = mg_len(sv);
  2487.     else
  2488.     junk = SvPV(sv, len);
  2489.     return len;
  2490. }
  2491.  
  2492. I32
  2493. sv_eq(str1,str2)
  2494. register SV *str1;
  2495. register SV *str2;
  2496. {
  2497.     char *pv1;
  2498.     STRLEN cur1;
  2499.     char *pv2;
  2500.     STRLEN cur2;
  2501.  
  2502.     if (!str1) {
  2503.     pv1 = "";
  2504.     cur1 = 0;
  2505.     }
  2506.     else
  2507.     pv1 = SvPV(str1, cur1);
  2508.  
  2509.     if (!str2)
  2510.     return !cur1;
  2511.     else
  2512.     pv2 = SvPV(str2, cur2);
  2513.  
  2514.     if (cur1 != cur2)
  2515.     return 0;
  2516.  
  2517.     return !bcmp(pv1, pv2, cur1);
  2518. }
  2519.  
  2520. I32
  2521. sv_cmp(str1,str2)
  2522. register SV *str1;
  2523. register SV *str2;
  2524. {
  2525.     I32 retval;
  2526.     char *pv1;
  2527.     STRLEN cur1;
  2528.     char *pv2;
  2529.     STRLEN cur2;
  2530.  
  2531.     if (!str1) {
  2532.     pv1 = "";
  2533.     cur1 = 0;
  2534.     }
  2535.     else
  2536.     pv1 = SvPV(str1, cur1);
  2537.  
  2538.     if (!str2) {
  2539.     pv2 = "";
  2540.     cur2 = 0;
  2541.     }
  2542.     else
  2543.     pv2 = SvPV(str2, cur2);
  2544.  
  2545.     if (!cur1)
  2546.     return cur2 ? -1 : 0;
  2547.     if (!cur2)
  2548.     return 1;
  2549.  
  2550.     if (cur1 < cur2) {
  2551.     /*SUPPRESS 560*/
  2552.     if (retval = memcmp((void*)pv1, (void*)pv2, cur1))
  2553.         return retval < 0 ? -1 : 1;
  2554.     else
  2555.         return -1;
  2556.     }
  2557.     /*SUPPRESS 560*/
  2558.     else if (retval = memcmp((void*)pv1, (void*)pv2, cur2))
  2559.     return retval < 0 ? -1 : 1;
  2560.     else if (cur1 == cur2)
  2561.     return 0;
  2562.     else
  2563.     return 1;
  2564. }
  2565.  
  2566. char *
  2567. sv_gets(sv,fp,append)
  2568. register SV *sv;
  2569. register FILE *fp;
  2570. I32 append;
  2571. {
  2572.     char *rsptr;
  2573.     STRLEN rslen;
  2574.     register STDCHAR rslast;
  2575.     register STDCHAR *bp;
  2576.     register I32 cnt;
  2577.     I32 i;
  2578.  
  2579. #ifdef FAST_SV_GETS
  2580.     /*
  2581.      * We're going to steal some values from the stdio struct
  2582.      * and put EVERYTHING in the innermost loop into registers.
  2583.      */
  2584.     register STDCHAR *ptr;
  2585.     STRLEN bpx;
  2586.     I32 shortbuffered;
  2587. #endif
  2588.  
  2589.     if (SvTHINKFIRST(sv)) {
  2590.     if (SvREADONLY(sv) && curcop != &compiling)
  2591.         croak(no_modify);
  2592.     if (SvROK(sv))
  2593.         sv_unref(sv);
  2594.     }
  2595.     if (!SvUPGRADE(sv, SVt_PV))
  2596.     return 0;
  2597.  
  2598.     if (RsSNARF(rs)) {
  2599.     rsptr = NULL;
  2600.     rslen = 0;
  2601.     }
  2602.     else if (RsPARA(rs)) {
  2603.     rsptr = "\n\n";
  2604.     rslen = 2;
  2605.     }
  2606.     else
  2607.     rsptr = SvPV(rs, rslen);
  2608.     rslast = rslen ? rsptr[rslen - 1] : '\0';
  2609.  
  2610.     if (RsPARA(rs)) {        /* have to do this both before and after */
  2611.     do {            /* to make sure file boundaries work right */
  2612.         if (feof(fp))
  2613.         return 0;
  2614.         i = getc(fp);
  2615.         if (i != '\n') {
  2616.         if (i == -1)
  2617.             return 0;
  2618.         ungetc(i,fp);
  2619.         break;
  2620.         }
  2621.     } while (i != EOF);
  2622.     }
  2623.  
  2624. #ifdef FAST_SV_GETS
  2625.  
  2626.     /* Here is some breathtakingly efficient cheating */
  2627.  
  2628.     cnt = FILE_cnt(fp);            /* get count into register */
  2629.     (void)SvPOK_only(sv);        /* validate pointer */
  2630.     if (SvLEN(sv) - append <= cnt + 1) { /* make sure we have the room */
  2631.     if (cnt > 80 && SvLEN(sv) > append) {
  2632.         shortbuffered = cnt - SvLEN(sv) + append + 1;
  2633.         cnt -= shortbuffered;
  2634.     }
  2635.     else {
  2636.         shortbuffered = 0;
  2637.         SvGROW(sv, append+cnt+2);/* (remembering cnt can be -1) */
  2638.     }
  2639.     }
  2640.     else
  2641.     shortbuffered = 0;
  2642.     bp = (STDCHAR*)SvPVX(sv) + append;  /* move these two too to registers */
  2643.     ptr = FILE_ptr(fp);
  2644.     for (;;) {
  2645.       screamer:
  2646.     if (cnt > 0) {
  2647.         if (rslen) {
  2648.         while (--cnt >= 0) {             /* this     |  eat */
  2649.             if ((*bp++ = *ptr++) == rslast)  /* really   |  dust */
  2650.             goto thats_all_folks;         /* screams  |  sed :-) */
  2651.         }
  2652.         }
  2653.         else {
  2654.             memcpy((char*)bp, (char*)ptr, cnt);  /* this     |  eat */    
  2655.         bp += cnt;                 /* screams  |  dust */   
  2656.         ptr += cnt;                 /* louder   |  sed :-) */
  2657.         cnt = 0;
  2658.         }
  2659.     }
  2660.     
  2661.     if (shortbuffered) {        /* oh well, must extend */
  2662.         cnt = shortbuffered;
  2663.         shortbuffered = 0;
  2664.         bpx = bp - (STDCHAR*)SvPVX(sv); /* box up before relocation */
  2665.         SvCUR_set(sv, bpx);
  2666.         SvGROW(sv, SvLEN(sv) + append + cnt + 2);
  2667.         bp = (STDCHAR*)SvPVX(sv) + bpx; /* unbox after relocation */
  2668.         continue;
  2669.     }
  2670.  
  2671. #ifdef macintosh
  2672.     FILE_ptr(fp) = ptr;
  2673.     i = (fgetc)(fp);
  2674. #else
  2675.     FILE_cnt(fp) = cnt;        /* deregisterize cnt and ptr */
  2676.     FILE_ptr(fp) = ptr;
  2677.     i = _filbuf(fp);        /* get more characters */
  2678. #endif
  2679.     cnt = FILE_cnt(fp);
  2680.     ptr = FILE_ptr(fp);        /* reregisterize cnt and ptr */
  2681.  
  2682.     if (i == EOF)            /* all done for ever? */
  2683.         goto thats_really_all_folks;
  2684.  
  2685.     bpx = bp - (STDCHAR*)SvPVX(sv);    /* box up before relocation */
  2686.     SvCUR_set(sv, bpx);
  2687.     SvGROW(sv, bpx + cnt + 2);
  2688.     bp = (STDCHAR*)SvPVX(sv) + bpx;    /* unbox after relocation */
  2689.  
  2690.     *bp++ = i;            /* store character from _filbuf */
  2691.  
  2692.     if (rslen && (STDCHAR)i == rslast)  /* all done for now? */
  2693.         goto thats_all_folks;
  2694.     }
  2695.  
  2696. thats_all_folks:
  2697.     if ((rslen > 1 && (bp - (STDCHAR*)SvPVX(sv) < rslen)) ||
  2698.       bcmp((char*)bp - rslen, rsptr, rslen))
  2699.     goto screamer;            /* go back to the fray */
  2700. thats_really_all_folks:
  2701.     if (shortbuffered)
  2702.     cnt += shortbuffered;
  2703. #ifndef macintosh
  2704.     FILE_cnt(fp) = cnt;            /* put these back or we're in trouble */
  2705. #endif
  2706.     FILE_ptr(fp) = ptr;
  2707.     *bp = '\0';
  2708.     SvCUR_set(sv, bp - (STDCHAR*)SvPVX(sv));  /* set length */
  2709.  
  2710. #else /* SV_FAST_GETS */
  2711.  
  2712.     /*The big, slow, and stupid way */
  2713.  
  2714.     {
  2715.     STDCHAR buf[8192];
  2716.  
  2717. screamer:
  2718.     if (rslen) {
  2719.         register STDCHAR *bpe = buf + sizeof(buf);
  2720.         bp = buf;
  2721.         while ((i = getc(fp)) != EOF && (*bp++ = i) != rslast && bp < bpe)
  2722.         ; /* keep reading */
  2723.         cnt = bp - buf;
  2724.     }
  2725.     else {
  2726.         cnt = fread((char*)buf, 1, sizeof(buf), fp);
  2727.         i = cnt ? (U8)buf[cnt - 1] : EOF;
  2728.     }
  2729.  
  2730.     if (append)
  2731.         sv_catpvn(sv, buf, cnt);
  2732.     else
  2733.         sv_setpvn(sv, buf, cnt);
  2734.  
  2735.     if (i != EOF &&            /* joy */
  2736.         (!rslen ||
  2737.          SvCUR(sv) < rslen ||
  2738.          bcmp(SvPVX(sv) + SvCUR(sv) - rslen, rsptr, rslen)))
  2739.     {
  2740.         append = -1;
  2741.         goto screamer;
  2742.     }
  2743.     }
  2744.  
  2745. #endif /* SV_FAST_GETS */
  2746.  
  2747.     if (RsPARA(rs)) {        /* have to do this both before and after */  
  2748.         while (i != EOF) {    /* to make sure file boundaries work right */
  2749.         i = getc(fp);
  2750.         if (i != '\n') {
  2751.         ungetc(i,fp);
  2752.         break;
  2753.         }
  2754.     }
  2755.     }
  2756.  
  2757.     return (SvCUR(sv) - append) ? SvPVX(sv) : Nullch;
  2758. }
  2759.  
  2760. void
  2761. sv_inc(sv)
  2762. register SV *sv;
  2763. {
  2764.     register char *d;
  2765.     int flags;
  2766.  
  2767.     if (!sv)
  2768.     return;
  2769.     if (SvTHINKFIRST(sv)) {
  2770.     if (SvREADONLY(sv) && curcop != &compiling)
  2771.         croak(no_modify);
  2772.     if (SvROK(sv)) {
  2773. #ifdef OVERLOAD
  2774.       if (SvAMAGIC(sv) && AMG_CALLun(sv,inc)) return;
  2775. #endif /* OVERLOAD */
  2776.       sv_unref(sv);
  2777.     }
  2778.     }
  2779.     if (SvGMAGICAL(sv))
  2780.     mg_get(sv);
  2781.     flags = SvFLAGS(sv);
  2782.     if (flags & SVp_IOK) {
  2783.     (void)SvIOK_only(sv);
  2784.     ++SvIVX(sv);
  2785.     return;
  2786.     }
  2787.     if (flags & SVp_NOK) {
  2788.     SvNVX(sv) += 1.0;
  2789.     (void)SvNOK_only(sv);
  2790.     return;
  2791.     }
  2792.     if (!(flags & SVp_POK) || !*SvPVX(sv)) {
  2793.     if ((flags & SVTYPEMASK) < SVt_PVNV)
  2794.         sv_upgrade(sv, SVt_NV);
  2795.     SvNVX(sv) = 1.0;
  2796.     (void)SvNOK_only(sv);
  2797.     return;
  2798.     }
  2799.     d = SvPVX(sv);
  2800.     while (isALPHA(*d)) d++;
  2801.     while (isDIGIT(*d)) d++;
  2802.     if (*d) {
  2803.         sv_setnv(sv,atof(SvPVX(sv)) + 1.0);  /* punt */
  2804.     return;
  2805.     }
  2806.     d--;
  2807.     while (d >= SvPVX(sv)) {
  2808.     if (isDIGIT(*d)) {
  2809.         if (++*d <= '9')
  2810.         return;
  2811.         *(d--) = '0';
  2812.     }
  2813.     else {
  2814.         ++*d;
  2815.         if (isALPHA(*d))
  2816.         return;
  2817.         *(d--) -= 'z' - 'a' + 1;
  2818.     }
  2819.     }
  2820.     /* oh,oh, the number grew */
  2821.     SvGROW(sv, SvCUR(sv) + 2);
  2822.     SvCUR(sv)++;
  2823.     for (d = SvPVX(sv) + SvCUR(sv); d > SvPVX(sv); d--)
  2824.     *d = d[-1];
  2825.     if (isDIGIT(d[1]))
  2826.     *d = '1';
  2827.     else
  2828.     *d = d[1];
  2829. }
  2830.  
  2831. void
  2832. sv_dec(sv)
  2833. register SV *sv;
  2834. {
  2835.     int flags;
  2836.  
  2837.     if (!sv)
  2838.     return;
  2839.     if (SvTHINKFIRST(sv)) {
  2840.     if (SvREADONLY(sv) && curcop != &compiling)
  2841.         croak(no_modify);
  2842.     if (SvROK(sv)) {
  2843. #ifdef OVERLOAD
  2844.       if (SvAMAGIC(sv) && AMG_CALLun(sv,dec)) return;
  2845. #endif /* OVERLOAD */
  2846.       sv_unref(sv);
  2847.     }
  2848.     }
  2849.     if (SvGMAGICAL(sv))
  2850.     mg_get(sv);
  2851.     flags = SvFLAGS(sv);
  2852.     if (flags & SVp_IOK) {
  2853.     (void)SvIOK_only(sv);
  2854.     --SvIVX(sv);
  2855.     return;
  2856.     }
  2857.     if (flags & SVp_NOK) {
  2858.     SvNVX(sv) -= 1.0;
  2859.     (void)SvNOK_only(sv);
  2860.     return;
  2861.     }
  2862.     if (!(flags & SVp_POK)) {
  2863.     if ((flags & SVTYPEMASK) < SVt_PVNV)
  2864.         sv_upgrade(sv, SVt_NV);
  2865.     SvNVX(sv) = -1.0;
  2866.     (void)SvNOK_only(sv);
  2867.     return;
  2868.     }
  2869.     sv_setnv(sv,atof(SvPVX(sv)) - 1.0);
  2870. }
  2871.  
  2872. /* Make a string that will exist for the duration of the expression
  2873.  * evaluation.  Actually, it may have to last longer than that, but
  2874.  * hopefully we won't free it until it has been assigned to a
  2875.  * permanent location. */
  2876.  
  2877. static void
  2878. sv_mortalgrow()
  2879. {
  2880.     tmps_max += 128;
  2881.     Renew(tmps_stack, tmps_max, SV*);
  2882. }
  2883.  
  2884. SV *
  2885. sv_mortalcopy(oldstr)
  2886. SV *oldstr;
  2887. {
  2888.     register SV *sv;
  2889.  
  2890.     new_SV();
  2891.     SvANY(sv) = 0;
  2892.     SvREFCNT(sv) = 1;
  2893.     SvFLAGS(sv) = 0;
  2894.     sv_setsv(sv,oldstr);
  2895.     if (++tmps_ix >= tmps_max)
  2896.     sv_mortalgrow();
  2897.     tmps_stack[tmps_ix] = sv;
  2898.     SvTEMP_on(sv);
  2899.     return sv;
  2900. }
  2901.  
  2902. SV *
  2903. sv_newmortal()
  2904. {
  2905.     register SV *sv;
  2906.  
  2907.     new_SV();
  2908.     SvANY(sv) = 0;
  2909.     SvREFCNT(sv) = 1;
  2910.     SvFLAGS(sv) = SVs_TEMP;
  2911.     if (++tmps_ix >= tmps_max)
  2912.     sv_mortalgrow();
  2913.     tmps_stack[tmps_ix] = sv;
  2914.     return sv;
  2915. }
  2916.  
  2917. /* same thing without the copying */
  2918.  
  2919. SV *
  2920. sv_2mortal(sv)
  2921. register SV *sv;
  2922. {
  2923.     if (!sv)
  2924.     return sv;
  2925.     if (SvREADONLY(sv) && curcop != &compiling)
  2926.     croak(no_modify);
  2927.     if (++tmps_ix >= tmps_max)
  2928.     sv_mortalgrow();
  2929.     tmps_stack[tmps_ix] = sv;
  2930.     SvTEMP_on(sv);
  2931.     return sv;
  2932. }
  2933.  
  2934. SV *
  2935. newSVpv(s,len)
  2936. char *s;
  2937. STRLEN len;
  2938. {
  2939.     register SV *sv;
  2940.  
  2941.     new_SV();
  2942.     SvANY(sv) = 0;
  2943.     SvREFCNT(sv) = 1;
  2944.     SvFLAGS(sv) = 0;
  2945.     if (!len)
  2946.     len = strlen(s);
  2947.     sv_setpvn(sv,s,len);
  2948.     return sv;
  2949. }
  2950.  
  2951. SV *
  2952. newSVnv(n)
  2953. double n;
  2954. {
  2955.     register SV *sv;
  2956.  
  2957.     new_SV();
  2958.     SvANY(sv) = 0;
  2959.     SvREFCNT(sv) = 1;
  2960.     SvFLAGS(sv) = 0;
  2961.     sv_setnv(sv,n);
  2962.     return sv;
  2963. }
  2964.  
  2965. SV *
  2966. newSViv(i)
  2967. IV i;
  2968. {
  2969.     register SV *sv;
  2970.  
  2971.     new_SV();
  2972.     SvANY(sv) = 0;
  2973.     SvREFCNT(sv) = 1;
  2974.     SvFLAGS(sv) = 0;
  2975.     sv_setiv(sv,i);
  2976.     return sv;
  2977. }
  2978.  
  2979. SV *
  2980. newRV(ref)
  2981. SV *ref;
  2982. {
  2983.     register SV *sv;
  2984.  
  2985.     new_SV();
  2986.     SvANY(sv) = 0;
  2987.     SvREFCNT(sv) = 1;
  2988.     SvFLAGS(sv) = 0;
  2989.     sv_upgrade(sv, SVt_RV);
  2990.     SvTEMP_off(ref);
  2991.     SvRV(sv) = SvREFCNT_inc(ref);
  2992.     SvROK_on(sv);
  2993.     return sv;
  2994. }
  2995.  
  2996. /* make an exact duplicate of old */
  2997.  
  2998. SV *
  2999. newSVsv(old)
  3000. register SV *old;
  3001. {
  3002.     register SV *sv;
  3003.  
  3004.     if (!old)
  3005.     return Nullsv;
  3006.     if (SvTYPE(old) == SVTYPEMASK) {
  3007.     warn("semi-panic: attempt to dup freed string");
  3008.     return Nullsv;
  3009.     }
  3010.     new_SV();
  3011.     SvANY(sv) = 0;
  3012.     SvREFCNT(sv) = 1;
  3013.     SvFLAGS(sv) = 0;
  3014.     if (SvTEMP(old)) {
  3015.     SvTEMP_off(old);
  3016.     sv_setsv(sv,old);
  3017.     SvTEMP_on(old);
  3018.     }
  3019.     else
  3020.     sv_setsv(sv,old);
  3021.     return sv;
  3022. }
  3023.  
  3024. void
  3025. sv_reset(s,stash)
  3026. register char *s;
  3027. HV *stash;
  3028. {
  3029.     register HE *entry;
  3030.     register GV *gv;
  3031.     register SV *sv;
  3032.     register I32 i;
  3033.     register PMOP *pm;
  3034.     register I32 max;
  3035.     char todo[256];
  3036.  
  3037.     if (!*s) {        /* reset ?? searches */
  3038.     for (pm = HvPMROOT(stash); pm; pm = pm->op_pmnext) {
  3039.         pm->op_pmflags &= ~PMf_USED;
  3040.     }
  3041.     return;
  3042.     }
  3043.  
  3044.     /* reset variables */
  3045.  
  3046.     if (!HvARRAY(stash))
  3047.     return;
  3048.  
  3049.     Zero(todo, 256, char);
  3050.     while (*s) {
  3051.     i = *s;
  3052.     if (s[1] == '-') {
  3053.         s += 2;
  3054.     }
  3055.     max = *s++;
  3056.     for ( ; i <= max; i++) {
  3057.         todo[i] = 1;
  3058.     }
  3059.     for (i = 0; i <= (I32) HvMAX(stash); i++) {
  3060.         for (entry = HvARRAY(stash)[i];
  3061.           entry;
  3062.           entry = entry->hent_next) {
  3063.         if (!todo[(U8)*entry->hent_key])
  3064.             continue;
  3065.         gv = (GV*)entry->hent_val;
  3066.         sv = GvSV(gv);
  3067.         (void)SvOK_off(sv);
  3068.         if (SvTYPE(sv) >= SVt_PV) {
  3069.             SvCUR_set(sv, 0);
  3070.             SvTAINT(sv);
  3071.             if (SvPVX(sv) != Nullch)
  3072.             *SvPVX(sv) = '\0';
  3073.         }
  3074.         if (GvAV(gv)) {
  3075.             av_clear(GvAV(gv));
  3076.         }
  3077.         if (GvHV(gv)) {
  3078.             if (HvNAME(GvHV(gv)))
  3079.             continue;
  3080.             hv_clear(GvHV(gv));
  3081. #ifndef VMS  /* VMS has no environ array */
  3082.             if (gv == envgv)
  3083.             environ[0] = Nullch;
  3084. #endif
  3085.         }
  3086.         }
  3087.     }
  3088.     }
  3089. }
  3090.  
  3091. CV *
  3092. sv_2cv(sv, st, gvp, lref)
  3093. SV *sv;
  3094. HV **st;
  3095. GV **gvp;
  3096. I32 lref;
  3097. {
  3098.     GV *gv;
  3099.     CV *cv;
  3100.  
  3101.     if (!sv)
  3102.     return *gvp = Nullgv, Nullcv;
  3103.     switch (SvTYPE(sv)) {
  3104.     case SVt_PVCV:
  3105.     *st = CvSTASH(sv);
  3106.     *gvp = Nullgv;
  3107.     return (CV*)sv;
  3108.     case SVt_PVHV:
  3109.     case SVt_PVAV:
  3110.     *gvp = Nullgv;
  3111.     return Nullcv;
  3112.     case SVt_PVGV:
  3113.     gv = (GV*)sv;
  3114.     *gvp = gv;
  3115.     *st = GvESTASH(gv);
  3116.     goto fix_gv;
  3117.  
  3118.     default:
  3119.     if (SvGMAGICAL(sv))
  3120.         mg_get(sv);
  3121.     if (SvROK(sv)) {
  3122.         cv = (CV*)SvRV(sv);
  3123.         if (SvTYPE(cv) != SVt_PVCV)
  3124.         croak("Not a subroutine reference");
  3125.         *gvp = Nullgv;
  3126.         *st = CvSTASH(cv);
  3127.         return cv;
  3128.     }
  3129.     if (isGV(sv))
  3130.         gv = (GV*)sv;
  3131.     else
  3132.         gv = gv_fetchpv(SvPV(sv, na), lref, SVt_PVCV);
  3133.     *gvp = gv;
  3134.     if (!gv)
  3135.         return Nullcv;
  3136.     *st = GvESTASH(gv);
  3137.     fix_gv:
  3138.     if (lref && !GvCV(gv)) {
  3139.         SV *tmpsv;
  3140.         ENTER;
  3141.         tmpsv = NEWSV(704,0);
  3142.         gv_efullname(tmpsv, gv);
  3143.         newSUB(start_subparse(),
  3144.            newSVOP(OP_CONST, 0, tmpsv),
  3145.            Nullop,
  3146.            Nullop);
  3147.         LEAVE;
  3148.         if (!GvCV(gv))
  3149.         croak("Unable to create sub named \"%s\"", SvPV(sv,na));
  3150.     }
  3151.     return GvCV(gv);
  3152.     }
  3153. }
  3154.  
  3155. #ifndef SvTRUE
  3156. I32
  3157. SvTRUE(sv)
  3158. register SV *sv;
  3159. {
  3160.     if (!sv)
  3161.     return 0;
  3162.     if (SvGMAGICAL(sv))
  3163.     mg_get(sv);
  3164.     if (SvPOK(sv)) {
  3165.     register XPV* Xpv;
  3166.     if ((Xpv = (XPV*)SvANY(sv)) &&
  3167.         (*Xpv->xpv_pv > '0' ||
  3168.         Xpv->xpv_cur > 1 ||
  3169.         (Xpv->xpv_cur && *Xpv->xpv_pv != '0')))
  3170.         return 1;
  3171.     else
  3172.         return 0;
  3173.     }
  3174.     else {
  3175.     if (SvIOK(sv))
  3176.         return SvIVX(sv) != 0;
  3177.     else {
  3178.         if (SvNOK(sv))
  3179.         return SvNVX(sv) != 0.0;
  3180.         else
  3181.         return sv_2bool(sv);
  3182.     }
  3183.     }
  3184. }
  3185. #endif /* SvTRUE */
  3186.  
  3187. #ifndef SvIV
  3188. IV SvIV(Sv)
  3189. register SV *Sv;
  3190. {
  3191.     if (SvIOK(Sv))
  3192.     return SvIVX(Sv);
  3193.     return sv_2iv(Sv);
  3194. }
  3195. #endif /* SvIV */
  3196.  
  3197.  
  3198. #ifndef SvNV
  3199. double SvNV(Sv)
  3200. register SV *Sv;
  3201. {
  3202.     if (SvNOK(Sv))
  3203.     return SvNVX(Sv);
  3204.     if (SvIOK(Sv))
  3205.     return (double)SvIVX(Sv);
  3206.     return sv_2nv(Sv);
  3207. }
  3208. #endif /* SvNV */
  3209.  
  3210. #ifdef CRIPPLED_CC
  3211. char *
  3212. sv_pvn(sv, lp)
  3213. SV *sv;
  3214. STRLEN *lp;
  3215. {
  3216.     if (SvPOK(sv)) {
  3217.     *lp = SvCUR(sv);
  3218.     return SvPVX(sv);
  3219.     }
  3220.     return sv_2pv(sv, lp);
  3221. }
  3222. #endif
  3223.  
  3224. char *
  3225. sv_pvn_force(sv, lp)
  3226. SV *sv;
  3227. STRLEN *lp;
  3228. {
  3229.     char *s;
  3230.  
  3231.     if (SvREADONLY(sv) && curcop != &compiling)
  3232.     croak(no_modify);
  3233.     
  3234.     if (SvPOK(sv)) {
  3235.     *lp = SvCUR(sv);
  3236.     }
  3237.     else {
  3238.     if (SvTYPE(sv) > SVt_PVLV && SvTYPE(sv) != SVt_PVFM) {
  3239.         if (SvFAKE(sv) && SvTYPE(sv) == SVt_PVGV) {
  3240.         sv_unglob(sv);
  3241.         s = SvPVX(sv);
  3242.         *lp = SvCUR(sv);
  3243.         }
  3244.         else
  3245.         croak("Can't coerce %s to string in %s", sv_reftype(sv,0),
  3246.             op_name[op->op_type]);
  3247.     }
  3248.     else
  3249.         s = sv_2pv(sv, lp);
  3250.     if (s != SvPVX(sv)) {    /* Almost, but not quite, sv_setpvn() */
  3251.         STRLEN len = *lp;
  3252.         
  3253.         if (SvROK(sv))
  3254.         sv_unref(sv);
  3255.         (void)SvUPGRADE(sv, SVt_PV);        /* Never FALSE */
  3256.         SvGROW(sv, len + 1);
  3257.         Move(s,SvPVX(sv),len,char);
  3258.         SvCUR_set(sv, len);
  3259.         *SvEND(sv) = '\0';
  3260.     }
  3261.     if (!SvPOK(sv)) {
  3262.         SvPOK_on(sv);        /* validate pointer */
  3263.         SvTAINT(sv);
  3264.         DEBUG_c(fprintf(Perl_debug_log,"0x%lx 2pv(%s)\n",
  3265.         (unsigned long)sv,SvPVX(sv)));
  3266.     }
  3267.     }
  3268.     return SvPVX(sv);
  3269. }
  3270.  
  3271. char *
  3272. sv_reftype(sv, ob)
  3273. SV* sv;
  3274. int ob;
  3275. {
  3276.     if (ob && SvOBJECT(sv))
  3277.     return HvNAME(SvSTASH(sv));
  3278.     else {
  3279.     switch (SvTYPE(sv)) {
  3280.     case SVt_NULL:
  3281.     case SVt_IV:
  3282.     case SVt_NV:
  3283.     case SVt_RV:
  3284.     case SVt_PV:
  3285.     case SVt_PVIV:
  3286.     case SVt_PVNV:
  3287.     case SVt_PVMG:
  3288.     case SVt_PVBM:
  3289.                 if (SvROK(sv))
  3290.                     return "REF";
  3291.                 else
  3292.                     return "SCALAR";
  3293.     case SVt_PVLV:        return "LVALUE";
  3294.     case SVt_PVAV:        return "ARRAY";
  3295.     case SVt_PVHV:        return "HASH";
  3296.     case SVt_PVCV:        return "CODE";
  3297.     case SVt_PVGV:        return "GLOB";
  3298.     case SVt_PVFM:        return "FORMLINE";
  3299.     default:        return "UNKNOWN";
  3300.     }
  3301.     }
  3302. }
  3303.  
  3304. int
  3305. sv_isobject(sv)
  3306. SV *sv;
  3307. {
  3308.     if (!SvROK(sv))
  3309.     return 0;
  3310.     sv = (SV*)SvRV(sv);
  3311.     if (!SvOBJECT(sv))
  3312.     return 0;
  3313.     return 1;
  3314. }
  3315.  
  3316. int
  3317. sv_isa(sv, name)
  3318. SV *sv;
  3319. char *name;
  3320. {
  3321.     if (!SvROK(sv))
  3322.     return 0;
  3323.     sv = (SV*)SvRV(sv);
  3324.     if (!SvOBJECT(sv))
  3325.     return 0;
  3326.  
  3327.     return strEQ(HvNAME(SvSTASH(sv)), name);
  3328. }
  3329.  
  3330. SV*
  3331. newSVrv(rv, classname)
  3332. SV *rv;
  3333. char *classname;
  3334. {
  3335.     SV *sv;
  3336.  
  3337.     new_SV();
  3338.     SvANY(sv) = 0;
  3339.     SvREFCNT(sv) = 0;
  3340.     SvFLAGS(sv) = 0;
  3341.     sv_upgrade(rv, SVt_RV);
  3342.     SvRV(rv) = SvREFCNT_inc(sv);
  3343.     SvROK_on(rv);
  3344.  
  3345.     if (classname) {
  3346.     HV* stash = gv_stashpv(classname, TRUE);
  3347.     (void)sv_bless(rv, stash);
  3348.     }
  3349.     return sv;
  3350. }
  3351.  
  3352. SV*
  3353. sv_setref_pv(rv, classname, pv)
  3354. SV *rv;
  3355. char *classname;
  3356. void* pv;
  3357. {
  3358.     if (!pv)
  3359.     sv_setsv(rv, &sv_undef);
  3360.     else
  3361.     sv_setiv(newSVrv(rv,classname), (IV)pv);
  3362.     return rv;
  3363. }
  3364.  
  3365. SV*
  3366. sv_setref_iv(rv, classname, iv)
  3367. SV *rv;
  3368. char *classname;
  3369. IV iv;
  3370. {
  3371.     sv_setiv(newSVrv(rv,classname), iv);
  3372.     return rv;
  3373. }
  3374.  
  3375. SV*
  3376. sv_setref_nv(rv, classname, nv)
  3377. SV *rv;
  3378. char *classname;
  3379. double nv;
  3380. {
  3381.     sv_setnv(newSVrv(rv,classname), nv);
  3382.     return rv;
  3383. }
  3384.  
  3385. SV*
  3386. sv_setref_pvn(rv, classname, pv, n)
  3387. SV *rv;
  3388. char *classname;
  3389. char* pv;
  3390. I32 n;
  3391. {
  3392.     sv_setpvn(newSVrv(rv,classname), pv, n);
  3393.     return rv;
  3394. }
  3395.  
  3396. SV*
  3397. sv_bless(sv,stash)
  3398. SV* sv;
  3399. HV* stash;
  3400. {
  3401.     SV *ref;
  3402.     if (!SvROK(sv))
  3403.         croak("Can't bless non-reference value");
  3404.     ref = SvRV(sv);
  3405.     if (SvFLAGS(ref) & (SVs_OBJECT|SVf_READONLY)) {
  3406.     if (SvREADONLY(ref))
  3407.         croak(no_modify);
  3408.     if (SvOBJECT(ref) && SvTYPE(ref) != SVt_PVIO)
  3409.         --sv_objcount;
  3410.     }
  3411.     SvOBJECT_on(ref);
  3412.     ++sv_objcount;
  3413.     (void)SvUPGRADE(ref, SVt_PVMG);
  3414.     SvSTASH(ref) = (HV*)SvREFCNT_inc(stash);
  3415.  
  3416. #ifdef OVERLOAD
  3417.     SvAMAGIC_off(sv);
  3418.     if (Gv_AMG(stash)) {
  3419.       SvAMAGIC_on(sv);
  3420.     }
  3421. #endif /* OVERLOAD */
  3422.  
  3423.     return sv;
  3424. }
  3425.  
  3426. static void
  3427. sv_unglob(sv)
  3428. SV* sv;
  3429. {
  3430.     assert(SvTYPE(sv) == SVt_PVGV);
  3431.     SvFAKE_off(sv);
  3432.     if (GvGP(sv))
  3433.     gp_free(sv);
  3434.     sv_unmagic(sv, '*');
  3435.     Safefree(GvNAME(sv));
  3436.     GvMULTI_off(sv);
  3437.     SvFLAGS(sv) &= ~SVTYPEMASK;
  3438.     SvFLAGS(sv) |= SVt_PVMG;
  3439. }
  3440.  
  3441. void
  3442. sv_unref(sv)
  3443. SV* sv;
  3444. {
  3445.     SV* rv = SvRV(sv);
  3446.     
  3447.     SvRV(sv) = 0;
  3448.     SvROK_off(sv);
  3449.     if (SvREFCNT(rv) != 1 || SvREADONLY(rv))
  3450.     SvREFCNT_dec(rv);
  3451.     else
  3452.     sv_2mortal(rv);        /* Schedule for freeing later */
  3453. }
  3454.  
  3455. #ifdef DEBUGGING
  3456.  
  3457. void
  3458. sv_dump(sv)
  3459. SV* sv;
  3460. {
  3461.     char tmpbuf[1024];
  3462.     char *d = tmpbuf;
  3463.     U32 flags;
  3464.     U32 type;
  3465.  
  3466.     if (!sv) {
  3467.     fprintf(Perl_debug_log, "SV = 0\n");
  3468.     return;
  3469.     }
  3470.     
  3471.     flags = SvFLAGS(sv);
  3472.     type = SvTYPE(sv);
  3473.  
  3474.     sprintf(d, "(0x%lx)\n  REFCNT = %ld\n  FLAGS = (",
  3475.     (unsigned long)SvANY(sv), (long)SvREFCNT(sv));
  3476.     d += strlen(d);
  3477.     if (flags & SVs_PADBUSY)    strcat(d, "PADBUSY,");
  3478.     if (flags & SVs_PADTMP)    strcat(d, "PADTMP,");
  3479.     if (flags & SVs_PADMY)    strcat(d, "PADMY,");
  3480.     if (flags & SVs_TEMP)    strcat(d, "TEMP,");
  3481.     if (flags & SVs_OBJECT)    strcat(d, "OBJECT,");
  3482.     if (flags & SVs_GMG)    strcat(d, "GMG,");
  3483.     if (flags & SVs_SMG)    strcat(d, "SMG,");
  3484.     if (flags & SVs_RMG)    strcat(d, "RMG,");
  3485.     d += strlen(d);
  3486.  
  3487.     if (flags & SVf_IOK)    strcat(d, "IOK,");
  3488.     if (flags & SVf_NOK)    strcat(d, "NOK,");
  3489.     if (flags & SVf_POK)    strcat(d, "POK,");
  3490.     if (flags & SVf_ROK)    strcat(d, "ROK,");
  3491.     if (flags & SVf_OOK)    strcat(d, "OOK,");
  3492.     if (flags & SVf_FAKE)    strcat(d, "FAKE,");
  3493.     if (flags & SVf_READONLY)    strcat(d, "READONLY,");
  3494.     d += strlen(d);
  3495.  
  3496.     if (flags & SVp_IOK)    strcat(d, "pIOK,");
  3497.     if (flags & SVp_NOK)    strcat(d, "pNOK,");
  3498.     if (flags & SVp_POK)    strcat(d, "pPOK,");
  3499.     if (flags & SVp_SCREAM)    strcat(d, "SCREAM,");
  3500.     d += strlen(d);
  3501.     if (d[-1] == ',')
  3502.     d--;
  3503.     *d++ = ')';
  3504.     *d = '\0';
  3505.  
  3506.     fprintf(Perl_debug_log, "SV = ");
  3507.     switch (type) {
  3508.     case SVt_NULL:
  3509.     fprintf(Perl_debug_log,"NULL%s\n", tmpbuf);
  3510.     return;
  3511.     case SVt_IV:
  3512.     fprintf(Perl_debug_log,"IV%s\n", tmpbuf);
  3513.     break;
  3514.     case SVt_NV:
  3515.     fprintf(Perl_debug_log,"NV%s\n", tmpbuf);
  3516.     break;
  3517.     case SVt_RV:
  3518.     fprintf(Perl_debug_log,"RV%s\n", tmpbuf);
  3519.     break;
  3520.     case SVt_PV:
  3521.     fprintf(Perl_debug_log,"PV%s\n", tmpbuf);
  3522.     break;
  3523.     case SVt_PVIV:
  3524.     fprintf(Perl_debug_log,"PVIV%s\n", tmpbuf);
  3525.     break;
  3526.     case SVt_PVNV:
  3527.     fprintf(Perl_debug_log,"PVNV%s\n", tmpbuf);
  3528.     break;
  3529.     case SVt_PVBM:
  3530.     fprintf(Perl_debug_log,"PVBM%s\n", tmpbuf);
  3531.     break;
  3532.     case SVt_PVMG:
  3533.     fprintf(Perl_debug_log,"PVMG%s\n", tmpbuf);
  3534.     break;
  3535.     case SVt_PVLV:
  3536.     fprintf(Perl_debug_log,"PVLV%s\n", tmpbuf);
  3537.     break;
  3538.     case SVt_PVAV:
  3539.     fprintf(Perl_debug_log,"PVAV%s\n", tmpbuf);
  3540.     break;
  3541.     case SVt_PVHV:
  3542.     fprintf(Perl_debug_log,"PVHV%s\n", tmpbuf);
  3543.     break;
  3544.     case SVt_PVCV:
  3545.     fprintf(Perl_debug_log,"PVCV%s\n", tmpbuf);
  3546.     break;
  3547.     case SVt_PVGV:
  3548.     fprintf(Perl_debug_log,"PVGV%s\n", tmpbuf);
  3549.     break;
  3550.     case SVt_PVFM:
  3551.     fprintf(Perl_debug_log,"PVFM%s\n", tmpbuf);
  3552.     break;
  3553.     case SVt_PVIO:
  3554.     fprintf(Perl_debug_log,"PVIO%s\n", tmpbuf);
  3555.     break;
  3556.     default:
  3557.     fprintf(Perl_debug_log,"UNKNOWN%s\n", tmpbuf);
  3558.     return;
  3559.     }
  3560.     if (type >= SVt_PVIV || type == SVt_IV)
  3561.     fprintf(Perl_debug_log, "  IV = %ld\n", (long)SvIVX(sv));
  3562.     if (type >= SVt_PVNV || type == SVt_NV)
  3563.     fprintf(Perl_debug_log, "  NV = %.*g\n", DBL_DIG, SvNVX(sv));
  3564.     if (SvROK(sv)) {
  3565.     fprintf(Perl_debug_log, "  RV = 0x%lx\n", (long)SvRV(sv));
  3566.     sv_dump(SvRV(sv));
  3567.     return;
  3568.     }
  3569.     if (type < SVt_PV)
  3570.     return;
  3571.     if (type <= SVt_PVLV) {
  3572.     if (SvPVX(sv))
  3573.         fprintf(Perl_debug_log, "  PV = 0x%lx \"%s\"\n  CUR = %ld\n  LEN = %ld\n",
  3574.         (long)SvPVX(sv), SvPVX(sv), (long)SvCUR(sv), (long)SvLEN(sv));
  3575.     else
  3576.         fprintf(Perl_debug_log, "  PV = 0\n");
  3577.     }
  3578.     if (type >= SVt_PVMG) {
  3579.     if (SvMAGIC(sv)) {
  3580.         fprintf(Perl_debug_log, "  MAGIC = 0x%lx\n", (long)SvMAGIC(sv));
  3581.     }
  3582.     if (SvSTASH(sv))
  3583.         fprintf(Perl_debug_log, "  STASH = %s\n", HvNAME(SvSTASH(sv)));
  3584.     }
  3585.     switch (type) {
  3586.     case SVt_PVLV:
  3587.     fprintf(Perl_debug_log, "  TYPE = %c\n", LvTYPE(sv));
  3588.     fprintf(Perl_debug_log, "  TARGOFF = %ld\n", (long)LvTARGOFF(sv));
  3589.     fprintf(Perl_debug_log, "  TARGLEN = %ld\n", (long)LvTARGLEN(sv));
  3590.     fprintf(Perl_debug_log, "  TARG = 0x%lx\n", (long)LvTARG(sv));
  3591.     sv_dump(LvTARG(sv));
  3592.     break;
  3593.     case SVt_PVAV:
  3594.     fprintf(Perl_debug_log, "  ARRAY = 0x%lx\n", (long)AvARRAY(sv));
  3595.     fprintf(Perl_debug_log, "  ALLOC = 0x%lx\n", (long)AvALLOC(sv));
  3596.     fprintf(Perl_debug_log, "  FILL = %ld\n", (long)AvFILL(sv));
  3597.     fprintf(Perl_debug_log, "  MAX = %ld\n", (long)AvMAX(sv));
  3598.     fprintf(Perl_debug_log, "  ARYLEN = 0x%lx\n", (long)AvARYLEN(sv));
  3599.     flags = AvFLAGS(sv);
  3600.     d = tmpbuf;
  3601.     if (flags & AVf_REAL)    strcat(d, "REAL,");
  3602.     if (flags & AVf_REIFY)    strcat(d, "REIFY,");
  3603.     if (flags & AVf_REUSED)    strcat(d, "REUSED,");
  3604.     if (*d)
  3605.         d[strlen(d)-1] = '\0';
  3606.     fprintf(Perl_debug_log, "  FLAGS = (%s)\n", d);
  3607.     break;
  3608.     case SVt_PVHV:
  3609.     fprintf(Perl_debug_log, "  ARRAY = 0x%lx\n",(long)HvARRAY(sv));
  3610.     fprintf(Perl_debug_log, "  KEYS = %ld\n", (long)HvKEYS(sv));
  3611.     fprintf(Perl_debug_log, "  FILL = %ld\n", (long)HvFILL(sv));
  3612.     fprintf(Perl_debug_log, "  MAX = %ld\n", (long)HvMAX(sv));
  3613.     fprintf(Perl_debug_log, "  RITER = %ld\n", (long)HvRITER(sv));
  3614.     fprintf(Perl_debug_log, "  EITER = 0x%lx\n",(long) HvEITER(sv));
  3615.     if (HvPMROOT(sv))
  3616.         fprintf(Perl_debug_log, "  PMROOT = 0x%lx\n",(long)HvPMROOT(sv));
  3617.     if (HvNAME(sv))
  3618.         fprintf(Perl_debug_log, "  NAME = \"%s\"\n", HvNAME(sv));
  3619.     break;
  3620.     case SVt_PVFM:
  3621.     case SVt_PVCV:
  3622.     fprintf(Perl_debug_log, "  STASH = 0x%lx\n", (long)CvSTASH(sv));
  3623.     fprintf(Perl_debug_log, "  START = 0x%lx\n", (long)CvSTART(sv));
  3624.     fprintf(Perl_debug_log, "  ROOT = 0x%lx\n", (long)CvROOT(sv));
  3625.     fprintf(Perl_debug_log, "  XSUB = 0x%lx\n", (long)CvXSUB(sv));
  3626.     fprintf(Perl_debug_log, "  XSUBANY = %ld\n", (long)CvXSUBANY(sv).any_i32);
  3627.     fprintf(Perl_debug_log, "  FILEGV = 0x%lx\n", (long)CvFILEGV(sv));
  3628.     fprintf(Perl_debug_log, "  DEPTH = %ld\n", (long)CvDEPTH(sv));
  3629.     fprintf(Perl_debug_log, "  PADLIST = 0x%lx\n", (long)CvPADLIST(sv));
  3630.     fprintf(Perl_debug_log, "  OUTSIDE = 0x%lx\n", (long)CvOUTSIDE(sv));
  3631.     if (type == SVt_PVFM)
  3632.         fprintf(Perl_debug_log, "  LINES = %ld\n", (long)FmLINES(sv));
  3633.     break;
  3634.     case SVt_PVGV:
  3635.     fprintf(Perl_debug_log, "  NAME = %s\n", GvNAME(sv));
  3636.     fprintf(Perl_debug_log, "  NAMELEN = %ld\n", (long)GvNAMELEN(sv));
  3637.     fprintf(Perl_debug_log, "  STASH = 0x%lx\n", (long)GvSTASH(sv));
  3638.     fprintf(Perl_debug_log, "  GP = 0x%lx\n", (long)GvGP(sv));
  3639.     fprintf(Perl_debug_log, "    SV = 0x%lx\n", (long)GvSV(sv));
  3640.     fprintf(Perl_debug_log, "    REFCNT = %ld\n", (long)GvREFCNT(sv));
  3641.     fprintf(Perl_debug_log, "    IO = 0x%lx\n", (long)GvIOp(sv));
  3642.     fprintf(Perl_debug_log, "    FORM = 0x%lx\n", (long)GvFORM(sv));
  3643.     fprintf(Perl_debug_log, "    AV = 0x%lx\n", (long)GvAV(sv));
  3644.     fprintf(Perl_debug_log, "    HV = 0x%lx\n", (long)GvHV(sv));
  3645.     fprintf(Perl_debug_log, "    CV = 0x%lx\n", (long)GvCV(sv));
  3646.     fprintf(Perl_debug_log, "    CVGEN = 0x%lx\n", (long)GvCVGEN(sv));
  3647.     fprintf(Perl_debug_log, "    LASTEXPR = %ld\n", (long)GvLASTEXPR(sv));
  3648.     fprintf(Perl_debug_log, "    LINE = %ld\n", (long)GvLINE(sv));
  3649.     fprintf(Perl_debug_log, "    FLAGS = 0x%x\n", (int)GvFLAGS(sv));
  3650.     fprintf(Perl_debug_log, "    STASH = 0x%lx\n", (long)GvSTASH(sv));
  3651.     fprintf(Perl_debug_log, "    EGV = 0x%lx\n", (long)GvEGV(sv));
  3652.     break;
  3653.     case SVt_PVIO:
  3654.     fprintf(Perl_debug_log, "  IFP = 0x%lx\n", (long)IoIFP(sv));
  3655.     fprintf(Perl_debug_log, "  OFP = 0x%lx\n", (long)IoOFP(sv));
  3656.     fprintf(Perl_debug_log, "  DIRP = 0x%lx\n", (long)IoDIRP(sv));
  3657.     fprintf(Perl_debug_log, "  LINES = %ld\n", (long)IoLINES(sv));
  3658.     fprintf(Perl_debug_log, "  PAGE = %ld\n", (long)IoPAGE(sv));
  3659.     fprintf(Perl_debug_log, "  PAGE_LEN = %ld\n", (long)IoPAGE_LEN(sv));
  3660.     fprintf(Perl_debug_log, "  LINES_LEFT = %ld\n", (long)IoLINES_LEFT(sv));
  3661.     fprintf(Perl_debug_log, "  TOP_NAME = %s\n", IoTOP_NAME(sv));
  3662.     fprintf(Perl_debug_log, "  TOP_GV = 0x%lx\n", (long)IoTOP_GV(sv));
  3663.     fprintf(Perl_debug_log, "  FMT_NAME = %s\n", IoFMT_NAME(sv));
  3664.     fprintf(Perl_debug_log, "  FMT_GV = 0x%lx\n", (long)IoFMT_GV(sv));
  3665.     fprintf(Perl_debug_log, "  BOTTOM_NAME = %s\n", IoBOTTOM_NAME(sv));
  3666.     fprintf(Perl_debug_log, "  BOTTOM_GV = 0x%lx\n", (long)IoBOTTOM_GV(sv));
  3667.     fprintf(Perl_debug_log, "  SUBPROCESS = %ld\n", (long)IoSUBPROCESS(sv));
  3668.     fprintf(Perl_debug_log, "  TYPE = %c\n", IoTYPE(sv));
  3669.     fprintf(Perl_debug_log, "  FLAGS = 0x%lx\n", (long)IoFLAGS(sv));
  3670.     break;
  3671.     }
  3672. }
  3673. #else
  3674. void
  3675. sv_dump(sv)
  3676. SV* sv;
  3677. {
  3678. }
  3679. #endif
  3680.  
  3681. IO*
  3682. sv_2io(sv)
  3683. SV *sv;
  3684. {
  3685.     IO* io;
  3686.     GV* gv;
  3687.  
  3688.     switch (SvTYPE(sv)) {
  3689.     case SVt_PVIO:
  3690.     io = (IO*)sv;
  3691.     break;
  3692.     case SVt_PVGV:
  3693.     gv = (GV*)sv;
  3694.     io = GvIO(gv);
  3695.     if (!io)
  3696.         croak("Bad filehandle: %s", GvNAME(gv));
  3697.     break;
  3698.     default:
  3699.     if (!SvOK(sv))
  3700.         croak(no_usym, "filehandle");
  3701.     if (SvROK(sv))
  3702.         return sv_2io(SvRV(sv));
  3703.     gv = gv_fetchpv(SvPV(sv,na), FALSE, SVt_PVIO);
  3704.     if (gv)
  3705.         io = GvIO(gv);
  3706.     else
  3707.         io = 0;
  3708.     if (!io)
  3709.         croak("Bad filehandle: %s", SvPV(sv,na));
  3710.     break;
  3711.     }
  3712.     return io;
  3713. }
  3714.  
  3715.